3
\$\begingroup\$

This will Search through all slides and shapes until it finds a chart, if it's not a Pie chart then it will open up the ActiveWorkbook behind that Chart then it will check the sheet for words in fndList and replace with with words in rplcList.

I would really just like to make this code run faster and smoother, and ask here in case there is a better/faster/more reliable way to do a find and replace for charts in PowerPoint.

Some things I believe could be improved are:

  • Every Chart has its ActiveWorksheet opened up and activated on the screen, so making this all run in the background would be nice.
  • I believe Excel.Application DisplayAlerts = False is a great solution to keeping the error We couldn't find anything to replace. Click options for more ways to search. from popping up, but if I'm not mistaken, turning off DisplayAlerts just automatically "clicks" the default value. So the pop-up still happens, and the code is still "pressing ok." So these are two unnecessary things that are happening in the background and consuming memory.
  • Late binding could be an option here, but I've never done it before and am not very familiar with how to do it correctly so I stayed away. But right now I have to load a reference to excel every time I run the code.

These are only three things that I could think of that could be improved. There might be many more.

Any and all help is appreciated. Thanks in advance!

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

Excel.Application.DisplayAlerts = False
Application.DisplayAlerts = False

fndList = Array("blue", "green")
rplcList = Array("Blue", "Green")

'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)

                    Worksheets(1).Cells.Replace What:=fndList(listArray), Replacement:=rplcList(listArray), _
                    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                    SearchFormat:=False, ReplaceFormat:=False


            Next listArray

            c.ChartData.Workbook.Close

        End If

nxtShpe:
    Next shpe

Next sld

Excel.Application.DisplayAlerts = True
Application.DisplayAlerts = True


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

End Sub
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

This is pretty well optimized. All I can say is that some variables could have better names

pptPres - targetPresentation
sld - targetSlide
shpe - targetShape
c - targetChartObject
sht - targetSheet
fndList - wordsToFind

Otherwise, like I said, there's nothing I can really say need to be optimized.

If you don't have to change the window viewtype and activate the chart data, I'd get rid of those.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.