Найдите текст в PowerPoint и замените его на текст из ячейки в Excel, используя VBA, но продолжайте получать ошибку времени выполнения '-2147024809 (80070057)' - PullRequest
Новая
       7

Найдите текст в PowerPoint и замените его на текст из ячейки в Excel, используя VBA, но продолжайте получать ошибку времени выполнения '-2147024809 (80070057)'

2 голосов
/ 01 мая 2019

Я пытаюсь найти и заменить список слов на слайде PowerPoint значениями из ячеек в файле Excel. Я использую VBA в PowerPoint, и он продолжает выдавать эту ошибку

Ошибка времени выполнения '-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

Я хочу, чтобы код успешно выполнял поиск и заменял все перечисленные слова в файле PPT входными данными из файла Excel. В коде я использовал переменную "y" как возможность зацикливания этого кода для нескольких строк ввода в файле Excel.

1 Ответ

1 голос
/ 02 мая 2019

Не все фигуры имеют TextFrame.

Из документации:

Используйте свойство HasTextFrame, чтобы определить, содержит ли фигура текстовую рамку, прежде чем применять TextFrame свойство.

Так попробуйте: 

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