Копирование объектов из презентации PowerPoint в Excel, но не вставка в правильном диапазоне

Question

Итак, у меня есть некоторый код VBA, который копирует один объект из PowerPoint (в данном случае текстовые поля) и вставляет его в определенные c диапазоны в книге. Его 90% есть, но есть проблема при вставке нескольких текстовых полей на одном листе. Код ниже вставляет 10 различных текстовых полей из 10 различных слайдов. слайды 4-7 наклеены на один лист, но 4 разных диапазона. Однако Слайды 4-6 вставляются друг на друга, только после вставленного диапазона первого, но по какой-то причине объект слайда 7 находится в правильном диапазоне.

Чтобы решить эту проблему, я попытался добавить периоды ожидания между ними, а также попытался изменить порядок копирования и вставки для всех слайдов, но ничего не работает. Может ли кто-нибудь , пожалуйста, помочь мне исправить это?

Dim Ppt As PowerPoint.Application

Sub Ppt_Extract_Shapes()
    'Add VBA References to PowerPoint 16.0 Type Library '''

    Set Ppt = VBA.CreateObject("PowerPoint.application")

    Dim filePath As String
    filePath = "put_your_file_name_here"

    With Ppt
        .Visible = msoTrue
        .Presentations.Open (filePath)

            paste_from_slide 3, "Summary", "M12"
            paste_from_slide 4, "Summary2", "F24"
            paste_from_slide 5, "Summary2", "F40"
            paste_from_slide 6, "Summary2", "F65"
            paste_from_slide 7, "Summary2", "F91"
            paste_from_slide 8, "Wages", "M11"
            paste_from_slide 9, "Supplies", "L9"
            paste_from_slide 10, "Ancillary", "M11"
            paste_from_slide 11, "Fixed", "AB4"
            paste_from_slide 11, "Debt", "S28"

        .Quit
    End With

End Sub

Function paste_from_slide(slideIndex As Integer, targetWsName As String, _
                          destinationRng As String, _
                          Optional shapeName As String = "Content Placeholder 1")

    Dim pptShape As PowerPoint.Shape
    Dim pptSlide As PowerPoint.Slide
    Dim exlShape As Excel.Shape

    Dim Ws As Excel.Worksheet
    Dim Rng As Excel.Range

    Set Ws = Excel.ThisWorkbook.Worksheets(targetWsName)
    Set Rng = Ws.Range(destinationRng)

    Set pptSlide = Ppt.ActivePresentation.Slides(slideIndex)
    Set pptShape = pptSlide.Shapes(shapeName)
        pptShape.Copy
        Ws.Paste
    Set exlShape = Ws.Shapes(shapeName)
        exlShape.Left = Rng.Left
        exlShape.Top = Rng.Top

End Function

Answer 1

Это может быть вашей проблемой:

 Set exlShape = Ws.Shapes(shapeName)

Нет гарантии, что имена фигур в Excel уникальны.

Если вы хотите, чтобы последний вставил фигуру, то это довольно надежно:

 Set exlShape = Ws.Shapes(Ws.Shapes.Count)