Question

因此，此代码将在PowerPoint图表上运行查找和替换。目标是更换x轴标签。我遇到的问题是我弹出这个问题：We couldn't find anything to replace. Click options for more ways to search." 每当图表没有找到我想要的单词时，它就会弹出。所以我添加了rngFound。我想能够说＆＃34;如果单词是Found，那么替换＆＃34;而不是让我的替换只是一次做所有事情。所以我去了Set rngFound = Worksheets(1).objRange.Find(fndList)。但它不起作用。我怀疑rngFound实际上并没有为我做任何事情，并希望对此问题有任何帮助。提前谢谢！

Option Explicit

Private Sub findAndReplaceChrt()

'Timer start
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

Dim pptPres As Object
Dim sld As Slide
Dim shpe As Shape
Dim c As Chart

Dim sht As Object
Dim fndList As Variant
Dim rplcList As Variant
Dim listArray As Long
Dim rngFound As Variant

fndList = Array("Red", "Purple")
rplcList = Array("red", "blue")

'Make pptPres the ppt active
Set pptPres = PowerPoint.ActivePresentation

'Loop through each sld and check for chart title, grab avgScore values and create pptTable to paste into ppt chart
For Each sld In pptPres.Slides

    'searches through shapes in the slide
    For Each shpe In sld.Shapes

        'Checks if shape is a Charts and has a Chart Title
        If Not shpe.HasChart Then GoTo nxtShpe

        Set c = shpe.Chart

        If Not c.ChartType = xlPie Then

            ActiveWindow.ViewType = ppViewNormal
            c.ChartData.Activate

            'Loop through each item in Array lists
            For listArray = LBound(fndList) To UBound(fndList)

                Set rngFound =  Worksheets(1).objRange.Find(fndList)

                If Not rngFound Is Nothing Then
                    Worksheets(1).Cells.Replace What:=fndList(listArray), Replacement:=rplcList(listArray), _
                    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                    SearchFormat:=False, ReplaceFormat:=False
                End If

            Next listArray

            c.ChartData.Workbook.Close

        End If

nxtShpe:
    Next shpe

Next sld


'End Timer
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

在PowerPoint Excel工作表上查找和替换图表

0 个答案: