Batch find and replace texts in powerpoint ?

[WHharris]

Hello everyone !

I have Thousands of PPT files，I want to find a Macro , to find and replace some texts in these ppt files.

I found this Macro (below), but this only work for one file ，Besides，it didnt work for some texts in group,

Is anyone can help me ?
My English is not very good


Hello everyone !

I have Thousands of PPT files，I want to find a Macro , to find and replace some texts in these ppt files.
I found this Macro (below), but this only work for one file ，Besides，it didnt work for some texts in group,
Is anyone can help me ? My English is not very good

Sub Multi_FindReplace()
    ' PURPOSE: Find & Replace a list of text/values throughout entire PowerPoint presentation
    ' INSERT THE LIST OF MERGE FIELDS HERE
    Dim FindList As Variant
    FindList = Array("word1", "word2", "word3")
    ' INSERT THE LIST OF VARIABLES TO BE INSERTED BY HERE
    Dim ReplaceList As Variant
    ReplaceList = Array("word1.1", "word2.1", "word3.1")
    ' Loop through each slide in Presentation
    Dim sld As Slide
    For Each sld In ActivePresentation.Slides
        Dim shp As Shape
        For Each shp In sld.Shapes
            ' for tables
            If shp.HasTable Then
                ReplaceWordsInTable shp, FindList, ReplaceList
            ElseIf shp.HasTextFrame Then
                ReplaceWordsInTextFrame shp, FindList, ReplaceList
            Else
                '--- doing nothing for all other shapes (at this time)
            End If
        Next shp
    Next sld
End Sub


Private Sub ReplaceWordsInTable(ByRef shp As Shape, _
    ByRef FindList As Variant, ByRef ReplaceList As Variant)
    ' give name to table
    Dim tbl As Table
    Set tbl = shp.Table
    ' loops on table rows and columns
    Dim i As Long
    Dim j As Long
    Dim ShpTxt As TextRange
    Dim TmpTxt As TextRange
    For i = 1 To shp.Table.Rows.Count
        For j = 1 To shp.Table.Columns.Count
            ' Store cell text into a variable
            Set ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange
            If ShpTxt <> "" Then
                ReplaceWordsInTextRange ShpTxt, FindList, ReplaceList
            End If
        Next j
    Next i
End Sub


Private Sub ReplaceWordsInTextFrame(ByRef shp As Shape, _
    ByRef FindList As Variant, ByRef ReplaceList As Variant)
    ' Store shape text into a variable
    Dim ShpTxt As TextRange
    Set ShpTxt = shp.TextFrame.TextRange
    If ShpTxt <> "" Then
        ReplaceWordsInTextRange ShpTxt, FindList, ReplaceList
    End If
End Sub


Private Sub ReplaceWordsInTextRange(ByRef thisRange As TextRange, _
    ByRef FindList As Variant, ByRef ReplaceList As Variant)
    Dim TmpTxt As TextRange
    Dim foundWord As TextRange
    Dim x As Long
    Dim nextCharPosition As Long
    Dim finished As Boolean
    nextCharPosition = 0
    For x = LBound(FindList) To UBound(FindList)
        finished = False
        Do While Not finished
            '--- find the word first, and capture the case of the starting character
            Set foundWord = thisRange.Find(FindWhat:=FindList(x), After:=nextCharPosition, _
            MatchCase:=msoFalse, _
            WholeWords:=msoFalse)
            If Not foundWord Is Nothing Then
                Dim firstCharUpper As Boolean
                firstCharUpper = (foundWord.Characters(0, 1) = UCase(foundWord.Characters(0, 1)))
                Set TmpTxt = thisRange.Replace(FindWhat:=FindList(x), _
                Replacewhat:=ReplaceList(x), _
                MatchCase:=msoFalse, _
                WholeWords:=msoFalse)
                nextCharPosition = TmpTxt.Start + Len(ReplaceList(x))
                If firstCharUpper Then
                    thisRange.Characters(TmpTxt.Start, 1) = UCase(thisRange.Characters(TmpTxt.Start, 1))
                End If
            Else
                finished = True
            End If
        Loop
    Next x
End Sub