Find text in PowerPoint and Replace with text from a cell in excel using VBA, but keep getting Run-time error '-2147024809 (80070057)'

问题

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 on PowerPoint and it keeps giving 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

Please help!

I've been going through the 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 and got no conclusive clues.

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 want the code to successfully search and replace all listed words within the PPT file with inputs from Excel file. In the code I used variable "y" as a possibility to loop this code for multiple rows of inputs within the Excel file.

回答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

来源：https://stackoverflow.com/questions/55940573/find-text-in-powerpoint-and-replace-with-text-from-a-cell-in-excel-using-vba-bu