在PowerPoint中查找文本并用Excel中单元格中的文本替换 [英] Find text in PowerPoint and Replace with text from a cell in Excel

问题描述

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

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.

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

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

我浏览了其他具有相似目的和错误的帖子，并尝试了20种不同的组合，无论是来自Internet还是来自我的想法，但均无效果.

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

我使用了变量"y"可以将此代码循环用于Excel文件中的多行输入.

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

推荐答案

并非所有形状都具有

Not all shapes have a TextFrame.

从文档中:

使用 HasTextFrame 属性确定形状是否包含文本框，然后再应用 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中单元格中的文本替换的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！