在 PowerPoint 中查找文本并替换为 Excel 单元格中的文本

我正在尝试查找 PowerPoint 幻灯片中的单词列表并将其替换为 Excel 文件中单元格中的值。我在 PowerPoint 中运行 VBA，但出现此错误。

运行时错误'-2147024809 (80070057)'：指定的值超出范围。

代码似乎停在这一行（第一行）：

Set ShpTxt = shp.TextFrame.TextRange

我浏览了其他具有类似目的和错误的帖子，并尝试了大约 20 种不同的组合（来自互联网和我的想法），但没有一个有效。

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

我使用变量“y”作为 Excel 文件中多行输入循环此代码的可能性。

并非所有形状都有TextFrame https://learn.microsoft.com/en-us/office/vba/api/powerpoint.shape.textframe.

从文档中：

Use the HasTextFrame属性来确定形状是否包含文本框架，然后再应用TextFrame财产。

So try:

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