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

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错误所致，该错误显然阻止您复制其数据标签链接到不连续的单元格范围的图表，从而在您遇到以下问题时出现“剪贴板为空...”错误随后尝试粘贴。此错误已在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复制粘贴图表剪贴板错误

3 个答案: