VBA: неверный запрос Shapes (неизвестный участник).указанный тип данных недоступен

Question

Я копирую некоторые диапазоны данных и диаграммы из Excel в PowerPoint через VBA. Это работает, но одна ошибка, от которой я не могу надежно избавиться. Msgstr "Неверный запрос фигуры (неизвестный элемент). Указанный тип данных недоступен." для строки mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile (обычно в цикле в SubSlide3)

Option Explicit

Public mySlide As PowerPoint.Slide
Public myShape As PowerPoint.Shape
Public PowerPointApp As PowerPoint.Application
Public myPresentation As PowerPoint.Presentation
Public rng As Range

Sub Analysis1()

    Dim PfadPPT As String, PfadExcel As String
    Dim wbKAP As Workbook
    Dim wsKAP As Worksheet
    Dim varJ As String, varM As String
    Dim RangeArray As Variant
'-------------Date-----------
    varJ = "2019"
    varM = "02"

'-------------Path&Array-----------
    RangeArray = Array("Range1", "Range2", "Range3", "Range4", "Range5", "Range6", "Range7", "Range8", "Range9", "Range10", "Range11")    
    PfadPPT = "H:\Kapitalanlageplanung und Abweichungsanalyse\Abweichungsanalyse_Template.pptm"
    PfadExcel = "G:\Kapitalanlageplanung - Präsentationen\Kapitalanlageplanung\" & varJ & "Reports\ReportKAP " & varJ & " " & varM & ".xlsm"

    Application.ScreenUpdating = False

    Set PowerPointApp = New PowerPoint.Application
    Set myPresentation = PowerPointApp.Presentations.Open(PfadPPT)
    Set wbKAP = Workbooks.Open(PfadExcel, UpdateLinks:=False)
    Set wsKAP = wbKAP.Sheets("TAA_VW")

    Call SubSlide1(wsKAP)
    Call SubSlide2(wsKAP)
    Call SubSlide3(wsKAP, RangeArray)

    Application.CutCopyMode = False
    wbKAP.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub


Sub SubSlide1(wsKAP As Worksheet)
    Set mySlide = myPresentation.Slides(1)

    Set rng = wsKAP.Range("AC2:AN29")
    rng.Copy
    DoEvents
    mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile

    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 20
        .Top = 48
        .Width = 623
    End With

    Set rng = wsKAP.Range("A187:V199")
    rng.Copy
    DoEvents
    mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile

    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
    With myShape
        .Left = 20
        .Top = 363
        .Width = 663
    End With
End Sub


Sub SubSlide2(wsKAP As Worksheet)
    Dim rowHght As Double

    Set mySlide = myPresentation.Slides(3)
    wsKAP.Columns("I:J").EntireColumn.Hidden = True
    wsKAP.Columns("K:M").EntireColumn.Hidden = False
    rowHght = wsKAP.Range("A109").EntireRow.RowHeight
    wsKAP.Rows("109").AutoFit
    wsKAP.Columns("Q:Y").ColumnWidth = 12

    Set rng = wsKAP.Range("A109:Y154")
    rng.Copy

    DoEvents
    mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    With myShape
        .Left = 0
        .Top = 75
        .Height = 314
    End With

    wsKAP.Columns("K:M").EntireColumn.Hidden = True
    wsKAP.Columns("I:J").EntireColumn.Hidden = False
    wsKAP.Range("A109").EntireRow.RowHeight = rowHght
    wsKAP.Columns("V:Y").ColumnWidth = 10
End Sub



Sub SubSlide3(wsKAP As Worksheet, RangeArray As Variant)
    Dim iSlide As Long
    Dim rngVW As Variant
    Dim fullNameVW As String

    iSlide = 3
    For Each rngVW In RangeArray

        'Data for charts
        wsKAP.Range(rngVW).Copy
        wsKAP.Select
        Range("tab.StartHeader").Select
        wsKAP.Range("tab.StartHeader").PasteSpecial Paste:=xlPasteValues

        'Title
        Select Case rngVW
            Case "Range1"
                fullNameVW = "Name1"
            Case "Range2"
                fullNameVW = "Name2"
            Case "Range3"
                fullNameVW = "Name3"
            Case "Range4"
                fullNameVW = "Name4"
            Case "Range5"
                fullNameVW = "Name5"
            Case "Range6"
                fullNameVW = "Name6"
            Case "Range7"
                fullNameVW = "Name7"
            Case "Range8"
                fullNameVW = "Name8"
            Case "Range9"
                fullNameVW = "Name9"
            Case "Range10"
                fullNameVW = "Name10"
            Case "11"
                fullNameVW = "Name11"
        End Select
        wsKAP.Range("C73") = fullNameVW

        Set mySlide = myPresentation.Slides(iSlide)

        'Overview
        Set rng = wsKAP.Range("C89:P97")
        rng.Copy
        DoEvents
        mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
        With myShape
            .Left = 20
            .Top = 71
            .Height = 92
        End With

        'Charts
        Set rng = wsKAP.Range("A30:Y69")
        rng.Copy
        'DoEvents
        Application.Wait (Now + TimeValue("0:00:01"))
        mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
        Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
        With myShape
            .Left = 20
            .Top = 187
            .Width = 686
        End With

        iSlide = iSlide + 1
        Application.CutCopyMode = False
    Next rngVW
End Sub

Я погуглил эту проблему, и первым делом вставил DoEvents. Это помогло, но иногда ошибка все еще происходит. Я попытал счастья с Application.Wait (Now + TimeValue("0:00:01")), но это тоже не было решением. С Application.Wait (Now + TimeValue("0:00:03")) у меня еще не было ошибки, но я должен еще ее протестировать, и, кроме того, я не хочу, чтобы этот макрос занимал так много времени. Я читал, что для некоторых людей проблема заключалась в том, что PowerPoint терял фокус при использовании ActiveWindow., Но я не ссылаюсь на свои слайды таким образом.