通过 VBA 复制粘贴图表时出错

Question

我一直在使用此代码来复制多个范围和图表。然而，随着我的代码的增长，它似乎失败了，在搜索了这个问题后，我认为这是由于图表/范围没有正确复制到剪贴板缓存/从剪贴板缓存复制而来。有没有办法避免这个错误？

错误 - “运行时错误'-2147188160（80048248）'：Shapes.PasteSpecial：无效请求。剪贴板为空或包含可能无法粘贴到此处的数据”

Public Sub CopyPasteHeadcountTopGraph()
    If PPT Is Nothing Then Exit Sub
    If PPT_pres Is Nothing Then Exit Sub

    Dim rng As Range
    Dim mySlide As Object
    Dim myShape As Object
    Dim cht As Chart

    Set mySlide = PPT_pres.Slides(6)

    With mySlide
    .Select
    Set cht = ThisWorkbook.Worksheets("Headcount").ChartObjects("HcChart").Chart

       cht.CopyPicture Appearance:=xlScreen, Format:=xlPicture, Size:=xlScreen
       .Shapes.Paste.Select 'ERROR HERE

        '''''''''''''''''''''''''''''''''
        'Paste as Chart and break link. '
        '''''''''''''''''''''''''''''''''
        'cht.ChartArea.Copy
        '.Shapes.Paste.Select


    'With .Shapes("HcChart")
        '.LinkFormat.BreakLink
    'End With

        PPT_pres.Windows(1).Selection.ShapeRange.Left = 35
        PPT_pres.Windows(1).Selection.ShapeRange.Top = 110
        PPT_pres.Windows(1).Selection.ShapeRange.Width = 655
        PPT_pres.Windows(1).Selection.ShapeRange.Height = 300

        End With

    'Clear The Clipboard
    Application.CutCopyMode = False
    Application.Wait (Now + TimeValue("00:00:01"))

End Sub

Answer 1

VBA 通常在对象尚未准备好处理时开始处理这些对象。当 VBA 尝试粘贴时，即使复制对象也可能不会完成（即，整个对象并未完全提交到剪贴板）。

我发现将某些操作放入一个单独的过程中可能足以让 VBA 在启动下一个进程之前等待一个后台进程完成。

例如，在下面的代码中，我已将 Paste 移出主过程。这使得 VBA 在粘贴之前等待复制完成，并且在定位粘贴的图表之前也等待粘贴完成。

事实上，我经常有三个独立的函数被主子调用：复制图表、粘贴图表和定位图表。

Public Sub CopyPasteHeadcountTopGraph()
    If PPT Is Nothing Then Exit Sub
    If PPT_pres Is Nothing Then Exit Sub

    Dim rng As Range
    Dim mySlide As Object
    Dim myShape As Object
    Dim cht As Chart

    Set mySlide = PPT_pres.Slides(6)

    With mySlide
    .Select
    Set cht = ThisWorkbook.Worksheets("Headcount").ChartObjects("HcChart").Chart

       cht.CopyPicture Appearance:=xlScreen, Format:=xlPicture, Size:=xlScreen

       '''''''''''''''''''''''''''''''''''
       '' .Shapes.Paste.Select 'ERROR HERE
       '''''''''''''''''''''''''''''''''''

       PasteChartIntoSlide mySlide

        PPT_pres.Windows(1).Selection.ShapeRange.Left = 35
        PPT_pres.Windows(1).Selection.ShapeRange.Top = 110
        PPT_pres.Windows(1).Selection.ShapeRange.Width = 655
        PPT_pres.Windows(1).Selection.ShapeRange.Height = 300

        End With

    'Clear The Clipboard
    Application.CutCopyMode = False
    Application.Wait (Now + TimeValue("00:00:01"))

End Sub

Function PasteChartIntoSlide(theSlide As Object) As Object
    theSlide.Shapes.Paste.Select
End Function