SHARE
TWEET

Untitled

a guest Oct 12th, 2017 48 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.  
  3. Private Sub findAndReplaceChrt()
  4.  
  5. 'Timer start
  6. Dim StartTime As Double
  7. Dim SecondsElapsed As Double
  8. StartTime = Timer
  9.  
  10. Dim pptPres As Object
  11. Dim sld As Slide
  12. Dim shpe As Shape
  13. Dim c As Chart
  14.  
  15. Dim sht As Object
  16. Dim fndList As Variant
  17. Dim rplcList As Variant
  18. Dim listArray As Long
  19. Dim rngFound As Variant
  20.  
  21. fndList = Array("Red", "Purple")
  22. rplcList = Array("red", "blue")
  23.  
  24. 'Make pptPres the ppt active
  25. Set pptPres = PowerPoint.ActivePresentation
  26.  
  27. 'Loop through each sld and check for chart title, grab avgScore values and create pptTable to paste into ppt chart
  28. For Each sld In pptPres.Slides
  29.  
  30.     'searches through shapes in the slide
  31.     For Each shpe In sld.Shapes
  32.  
  33.         'Checks if shape is a Charts and has a Chart Title
  34.         If Not shpe.HasChart Then GoTo nxtShpe
  35.  
  36.         Set c = shpe.Chart
  37.  
  38.         If Not c.ChartType = xlPie Then
  39.  
  40.             ActiveWindow.ViewType = ppViewNormal
  41.             c.ChartData.Activate
  42.  
  43.             'Loop through each item in Array lists
  44.             For listArray = LBound(fndList) To UBound(fndList)
  45.  
  46.                 Set rngFound =  Worksheets(1).objRange.Find(fndList)
  47.  
  48.                 If Not rngFound Is Nothing Then
  49.                     Worksheets(1).Cells.Replace What:=fndList(listArray), Replacement:=rplcList(listArray), _
  50.                     LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
  51.                     SearchFormat:=False, ReplaceFormat:=False
  52.                 End If
  53.  
  54.             Next listArray
  55.  
  56.             c.ChartData.Workbook.Close
  57.  
  58.         End If
  59.  
  60. nxtShpe:
  61.     Next shpe
  62.  
  63. Next sld
  64.  
  65.  
  66. 'End Timer
  67. SecondsElapsed = Round(Timer - StartTime, 2)
  68. MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
  69.  
  70. End Sub
RAW Paste Data
Top