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
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 = Falseis 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