VBA for Find and Replace a string of text

[Paul_Hossler]

Here's what I've been using - it covers the cases I usually have

When something new comes up, I just expand it

Sub drv()


    Call pvtReplaceText("zzzzzzzz", "12345678", True)


End Sub


'http://skp.mvps.org/ppt00025.htm#2
Sub pvtReplaceText(sOld As String, sNew As String, Optional bWholeWord As Boolean = False)
    
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim oText As TextRange
    Dim oTemp As TextRange
    
    For Each oSlide In ActivePresentation.Slides


        For Each oShape In oSlide.Shapes
            Call pvtReplaceText1(oShape, sOld, sNew, bWholeWord)
        Next oShape
    
    Next oSlide


End Sub




Private Sub pvtReplaceText1(oShape As Object, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
    Dim oText As TextRange
    Dim oTemp As TextRange
    Dim i As Long, iRows As Long, iCols As Integer
    Dim oShapeTmp As Shape
 
    Select Case oShape.Type
    
        Case msoPlaceholder
            Call pvtText(oShape, FindString, ReplaceString, bWholeWord)
            If oShape.HasTable Then
                Call pvtTable(oShape.Table, FindString, ReplaceString, bWholeWord)
            End If
            If oShape.HasSmartArt Then
                Call pvtSmartArt(oShape.SmartArt, FindString, ReplaceString)
            End If
        
        Case msoTable
            Call pvtTable(oShape.Table, FindString, ReplaceString, bWholeWord)
        
        Case msoGroup    'Groups may contain shapes with text, so look within it
            For i = 1 To oShape.GroupItems.Count
                Call pvtReplaceText1(oShape.GroupItems(i), FindString, ReplaceString)
            Next i
        
        Case msoDiagram
            Call pvtNodes(oShape.Diagram, FindString, ReplaceString)
            
        Case msoSmartArt
            Call pvtSmartArt(oShape.SmartArt, FindString, ReplaceString)
            
        Case Else
            Call pvtText(oShape, FindString, ReplaceString, bWholeWord)
        End Select
End Sub




Private Sub pvtTable(oTable As Table, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
    Dim iRows As Long, iCols As Integer
    Dim oShapeTmp As Shape
    
    With oTable
        For iRows = 1 To .Rows.Count
            For iCols = 1 To .Rows(iRows).Cells.Count
                Set oShapeTmp = .Rows(iRows).Cells(iCols).Shape
                Call pvtText(oShapeTmp, FindString, ReplaceString, bWholeWord)
            Next
        Next
    End With
End Sub




Private Sub pvtText(oShape As Shape, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
    Dim oTextRange As TextRange, oTextRangeTemp As TextRange
    Dim i As Long


    With oShape
            
        If Not .HasTextFrame Then Exit Sub
        If Not .TextFrame.HasText Then Exit Sub
                    
         Set oTextRange = .TextFrame.TextRange
         Set oTextRangeTemp = oTextRange.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
         Do While Not oTextRangeTemp Is Nothing
             Set oTextRangeTemp = oTextRange.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
         Loop
     
         For i = 1 To oTextRange.Paragraphs.Count
             Set oTextRange = oTextRange.Paragraphs(i)
             oTextRange.Text = Trim(oTextRange.Text)
             oTextRange.Characters(1, 1) = UCase(oTextRange.Characters(1, 1))
         Next i
    End With
End Sub


Private Sub pvtNodes(oDiagram As Diagram, FindString As String, ReplaceString As String)
    Dim i As Long
    
    With oDiagram
        For i = 1 To .Nodes.Count
            Call pvtText(.Nodes(i).TextShape, FindString, ReplaceString)
        Next i
    End With
End Sub


Private Sub pvtSmartArt(oSmartart As SmartArt, FindString As String, ReplaceString As String)
    Dim i As Long
    Dim s As String
    
    With oSmartart
        For i = 1 To .Nodes.Count
            s = .AllNodes(i).TextFrame2.TextRange.Text
            .AllNodes(i).TextFrame2.TextRange.Text = Replace(s, FindString, ReplaceString)
        Next i
    End With
End Sub