Powerpoint VBA L oop все слайды, проверьте заголовок, если правильный заголовок, вставьте фигуры в другую презентацию

Question

Цель: -L oop через презентацию, проверяя каждый слайд на наличие определенного заголовка -Как только название найдено -Скопируйте формы для диаграмм и сноски -Тогда вставьте их в отдельную презентацию.

Примечания: -Слайды в презентациях не имеют названий, но расположены в Shapes (1) -Я получаю

ошибка времени выполнения '-2147024809 (80070057)': указанное значение выходит за пределы диапазона.

-Эта ошибка возникает в строке оператор If

Sub library_update()

Dim NTppt As Presentation
Set NTppt = Application.Presentations("Z:\NTPath\NLibrary.pptx")

Dim ppt As Presentation
Set ppt = Application.Presentations("Z:\NTPath\Library.pptm")

Dim sld as slide

For Each sld In NTppt.Slides
        If sld.Shapes(1).TextFrame.TextRange.Text = "Fixed Income - Yield Curves" Then
            With NTppt
                sld.Shapes.Range(Array(2, 3)).Copy
                ppt.Slides(1).Shapes.Paste
            End With
        End If
Next sld

End Sub

Answer 1

Решение ниже сработало. Я не уверен, почему мой код выдал исходную ошибку времени выполнения, но я предполагаю, что это связано с тем, что на некоторых из моих слайдов PowerPoint не было найдено фигур (1).

Чтобы устранить проблему, я искал " Фиксированный доход - Кривые доходности »во всех формах всех слайдов.

Sub library_update()

Dim NTppt As Presentation
Set NTppt = Application.Presentations("Z:\NTPath\NLibrary.pptx")

Dim ppt As Presentation
Set ppt = Application.Presentations("Z:\NTPath\Library.pptm")

Dim sld As Slide
Dim shp As Shape

For Each sld In NTppt.Slides
    For Each shp In sld.Shapes
        If shp.HasTextFrame Then
            Set txt_range = shp.TextFrame.TextRange
            'Confirm exact spelling and capitalization of the slides or an error will return
            If txt_range = "Fixed Income – Yield Curves" Then
                With NTppt
                    sld.Shapes.Range(Array(2, 3)).Copy
                    ppt.Slides(2).Shapes.Paste
                End With
            End If
        End If
    Next shp
Next sld


End Sub