Find text in PowerPoint and Replace with text from a cell in Excel

Question

I'm trying to find and replace a list of words inside a PowerPoint slide with values from cells in an Excel file. I'm running the VBA in PowerPoint and it gives this error.

Run-time error '-2147024809 (80070057)': The specified value is out of range.

The code seems to stop at this line (the first one):

Set ShpTxt = shp.TextFrame.TextRange

I've gone through other posts that have similar purposes and errors and tried about 20 different combinations, from both the Internet and from my ideas but none works.

Sub MergePPT3()

    Dim pp As Object
    Dim pptemplate As Object
    'Dim headerbox As TextRange
    'Dim contextbox As TextRange
    Dim x As Long
    Dim y As Long
    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 ExApp As Object
    Dim ExInput As Object
    
    Dim SuName As String
    Dim WFWS As String
    Dim WFYOY As String
    Dim CGWS As String
    Dim CGYOY As String
    Dim RNKG As String
    Dim MKTCAT As String
    
    Set ExApp = GetObject(, "Excel.Application")
    ExApp.Visible = True
    Set ExInput = ExApp.Workbooks.Open(ActivePresentation.Path & "/Testing.xlsm")
    
    y = 2
    
    SuName = ExInput.Sheets("SuIDs").Range("B" & y).Value
    WFWS = ExInput.Sheets("SuIDs").Range("C" & y).Value
    WFYOY = ExInput.Sheets("SuIDs").Range("D" & y).Value
    CGWS = ExInput.Sheets("SuIDs").Range("E" & y).Value
    CGYOY = ExInput.Sheets("SuIDs").Range("F" & y).Value
    RNKG = ExInput.Sheets("SuIDs").Range("G" & y).Value
    MKTCAT = ExInput.Sheets("SuIDs").Range("H" & y).Value
    
    FindList = Array("SUNAME", "WFWS", "WFYOY", "CGWS", "CGYOY", "RNKG", "MKTCAT")
    ReplaceList = Array(SuName, WFWS, WFYOY, CGWS, CGYOY, RNKG, MKTCAT)
    
     For Each sld In ActivePresentation.Slides
        
        For Each shp In sld.Shapes
          'Store shape text into a variable
            Set ShpTxt = shp.TextFrame.TextRange
          
          'Ensure There is Text To Search Through
            If ShpTxt <> "" Then
              For x = LBound(FindList) To UBound(FindList)
                
                'Store text into a variable
                 Set ShpTxt = shp.TextFrame.TextRange
                
                'Find First Instance of "Find" word (if exists)
                 Set TmpTxt = ShpTxt.Replace( _
                   FindWhat:=FindList(x), _
                   Replacewhat:=ReplaceList(x), _
                   WholeWords:=True)
            
                'Find Any Additional instances of "Find" word (if exists)
                  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

I used variable "y" as a possibility to loop this code for multiple rows of inputs within the Excel file.

Answer 1

Not all shapes have a TextFrame.

From the documentation:

Use the HasTextFrame property to determine whether a shape contains a text frame before you apply the TextFrame property.

So try:

If shp.HasTextFrame
    Set ShpTxt = shp.TextFrame.TextRange
End If