This code is to find and replace a list of text for quality check
sub FindAndReplace()
Dim Pres As Presentation
Dim sld As Slide
Dim shp As Shape
For Each Pres In Application.Presentations
For Each sld In Pres.Slides
For Each shp In sld.Shapes
Call checklist(shp)
Next shp
Next sld
Next Pres
MsgBox "Completed Succesfully!"
End Sub
Sub checklist(shp As Object)
Dim txtRng As TextRange
Dim rngFound As TextRange
Dim I, K, X As Long
Dim iRows As Integer
Dim iCols As Integer
Dim TargetList, DestinationList
TargetList = Array(" ", " ", " ", " ", " ", " ", " ", " / ", "i.e. ", "e.g. ", "/ ", " /", " :", " ;", " .", " ,", " - ", "resume", "a.m.", "p.m.", ":00")
DestinationList = Array(" ", " ", " ", " ", " ", " ", " ", "/", "i.e., ", "e.g., ", "/", "/", ":", ";", ".", ",", " – ", "résumé", "am", "")
With shp
If shp.HasTable Then
For iRows = 1 To shp.Table.Rows.Count
For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
For I = 0 To UBound(TargetList)
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
Do While Not rngFound Is Nothing
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
Loop
Next
Next
Next
End If
End With
Select Case shp.Type
Case msoGroup
For X = 1 To shp.GroupItems.Count
Call checklist(shp.GroupItems(X))
Next X
Case 21
For X = 1 To shp.Diagram.Nodes.Count
Call checklist(shp.GroupItems(X))
Next X
Case Else
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Set txtRng = shp.TextFrame.TextRange
For I = 0 To UBound(TargetList)
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
Do While Not rngFound Is Nothing
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
Loop
Next
End If
End If
End Select
End Sub
I am getting run time 9 error for this code.
Also this code is replacing only the first occurrence of the certain words like "i.e." and "e.g:, but I want to replace all the occurrences.
The reason for the error is that you are trying to reference item 21 in the DestinationList array and it doesn't exist because you are missing a corresponding argument for "p.m." I added error checking for that, corrected the Dim line for I, K, X and change 0 to LBound when looping the arrays because if the base is not 0, that will cause issues too. Corrected code:
Option Explicit
Private ArrayError As Boolean
Sub FindAndReplace()
Dim Pres As Presentation
Dim sld As Slide
Dim shp As Shape
ArrayError = False
For Each Pres In Application.Presentations
For Each sld In Pres.Slides
For Each shp In sld.Shapes
If Not ArrayError Then checklist shp
Next shp
Next sld
Next Pres
If Not ArrayError Then MsgBox "Completed Succesfully!"
End Sub
Sub checklist(shp As Object)
Dim txtRng As TextRange
Dim rngFound As TextRange
Dim I As Long, K As Long, X As Long
Dim iRows As Integer
Dim iCols As Integer
Dim TargetList, DestinationList
TargetList = Array(" ", " ", " ", " ", " ", " ", " ", " / ", "i.e. ", "e.g. ", "/ ", " /", " :", " ;", " .", " ,", " - ", "resume", "a.m.", "p.m.", ":00")
DestinationList = Array(" ", " ", " ", " ", " ", " ", " ", "/", "i.e., ", "e.g., ", "/", "/", ":", ";", ".", ",", " ? ", "résumé", "am", "pm", "")
If Not UBound(TargetList) = UBound(DestinationList) Then
MsgBox "Search and Replace arrary do not have the same number of arguments.", vbCritical + vbOKOnly, "Arrays Don't Match"
ArrayError = True
Exit Sub
End If
With shp
If shp.HasTable Then
For iRows = 1 To shp.Table.Rows.Count
For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
For I = LBound(TargetList) To UBound(TargetList)
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
Do While Not rngFound Is Nothing
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
Loop
Next
Next
Next
End If
End With
Select Case shp.Type
Case msoGroup
For X = 1 To shp.GroupItems.Count
Call checklist(shp.GroupItems(X))
Next X
Case 21
For X = 1 To shp.Diagram.Nodes.Count
Call checklist(shp.GroupItems(X))
Next X
Case Else
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Set txtRng = shp.TextFrame.TextRange
For I = LBound(TargetList) To UBound(TargetList)
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
Do While Not rngFound Is Nothing
Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
Loop
Next
End If
End If
End Select
End Sub