Попытка найти / заменить в PowerPoint с помощью VBA

Question

Я пытаюсь найти / заменить несколько слов / фраз в powerpoint, используя VBA. Приведенный ниже код застревает в «Set ShpTxt = shp.TextFrame.TextRange» с ошибкой, говорящей «Указанное значение выходит за пределы диапазона». Это происходит в середине документа, в то время как более ранние вхождения «МЕСЯЦ ХХ, 20ХХ» не заменяются. Пожалуйста, помогите!

Sub Multi_FindReplace()

Dim sld As Slide
Dim shp As Shape
Dim ShpTxt As TextRange
Dim TmpTxt As TextRange
Dim FindList As Variant
Dim ReplaceList As Variant
Dim x As Long

FindList = Array("MONTH XX, 20XX", "United States", "Mexico")
ReplaceList = Array("September 22, 2020", "USA", "MEX")

 For Each sld In ActivePresentation.Slides 
   For Each shp In sld.Shapes
    Set ShpTxt = shp.TextFrame.TextRange

    If ShpTxt <> "" Then
      For x = LBound(FindList) To UBound(FindList)

          Set ShpTxt = shp.TextFrame.TextRange

          Set TmpTxt = ShpTxt.Replace( _
           FindWhat:=FindList(x), _
           Replacewhat:=ReplaceList(x), _
           WholeWords:=True)

          Do While Not TmpTxt Is Nothing
            Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, 
             ShpTxt.Length)
            Set TmpTxt = ShpTxt.Replace( _
             FindWhat:=FindList(x), _
             Replacewhat:=ReplaceList(x), _
             WholeWords:=True)
          Loop

         Next x

        End If

    Next shp

  Next sld

End Sub