VBA：形状（未知成员）无效请求。指定的数据类型不可用

Question

我通过VBA将一些数据范围和图表从Excel复制到PowerPoint。它可以工作，但是我无法可靠地消除一个错误。 “形状（未知成员）无效的请求。指定的数据类型不可用。” 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"))时，我还没有发生错误，但是我必须对其进行更多的测试，此外，我真的不希望这个宏花那么长时间。我读过某些人的问题是使用ActiveWindow时PowerPoint失去了焦点。但是我没有那样引用我的幻灯片。