使用VBA在PowerPoint中查找文本并用excel中的单元格中的文本替换,但始终出现运行时错误“ -2147024809(80070057)”

时间:2019-05-01 18:03:09

标签: excel vba replace runtime-error powerpoint

我试图用来自Excel文件中单元格的值查找并替换PowerPoint幻灯片中的单词列表。我在PowerPoint上运行VBA,并且不断出现此错误

  

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

代码似乎停止在这一行(第一行):

Set ShpTxt = shp.TextFrame.TextRange

请帮助!

我一直在浏览其他目的和错误相似的帖子,并尝试了20种不同的组合,无论是来自Internet还是来自我的想法,但均无效果,也没有明确的线索。

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

我希望代码成功搜索PPT文件中所有列出的单词,并将其替换为Excel文件中的输入。在代码中,我使用变量“ y”来为Excel文件中的多行输入循环此代码。

1 个答案:

答案 0 :(得分:1)

并非所有形状都具有TextFrame

从文档中:

  

使用 HasTextFrame 属性确定形状是否包含文本框,然后再应用 TextFrame 属性。

所以尝试:

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