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

Question

我一直在使用此代码复制多个范围和图表。然而，随着我的代码的增长，它似乎崩溃了，用谷歌搜索了这个问题，我认为这是由于 chart/range 没有正确复制 to/from 剪贴板缓存引起的。有没有办法避免这个错误？

Error - " Run-time error '-2147188160 (80048248)': Shapes.PasteSpecial :Invalid request. Clipboard is empty or contains data which may not be pasted here"

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 等待一个后台进程完成，然后再开始下一个。

例如，在下面的代码中，我已将粘贴移出主程序。这使得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

Answer 2

我不得不使用这段代码来解决这个问题。对函数或 DoEvents 的调用不够：

...
ActiveChart.ChartArea.Copy
aplicacion = RUTA & "\freemem.vbe"
lngErr = ShellExecute(0, "OPEN", aplicacion, "", "", 0)
Call pegadatos(PPSlide)
...

先前将 shellexecute 函数声明为

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

freemem.vbe 是一个只有一行的文本文件：Mystring=(80000000)。创建 .txt 文件后，您必须将扩展名更改为 .vbe。

和 pegadatos:

Sub pegadatos(TheSlide As Object)
TheSlide.Shapes.Paste.Select
End Sub

Answer 3

此错误也可能是由于 Excel 错误造成的，该错误显然会阻止您复制其数据标签链接到 non-contiguous 单元格区域的图表，这样您会得到 "Clipboard is empty..." 随后尝试粘贴时出错。此错误在 Excel 2013 年及更新版本中重现，并在以下位置进行了额外描述：

https://answers.microsoft.com/en-us/msoffice/forum/all/chart-with-data-labels-will-not-copy-to-clipboard/e60dcb59-8644-464a-8e13-0f5f62c4be76?auth=1

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

Error when copy pasting a chart through VBA

excel

powerpoint

vba