Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement