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

Question

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

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

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

Set ShpTxt = shp.TextFrame.TextRange

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

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 文件中为多行输入循环此代码的可能性。

Answer 1

并非所有形状都有 TextFrame。

来自文档：

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

所以尝试：

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

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

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

excel

powerpoint

vba

replace

runtime-error