Ошибка буфера обмена диаграммы вставки копии VBA - PullRequest
Новая
       12

Ошибка буфера обмена диаграммы вставки копии VBA

0 голосов
/ 02 мая 2018

Я использовал этот код для копирования по нескольким диапазонам и диаграммам. Однако, поскольку мой код вырос, он, кажется, падает, погуглив вокруг проблемы, я думаю, это вызвано тем, что график / диапазон неправильно копируются в / из кэша буфера обмена. Есть ли способ избежать этой ошибки?

Ошибка - «Ошибка времени выполнения -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

Ответы [ 3 ]

0 голосов
/ 05 февраля 2019

Мне пришлось использовать этот код для решения этой проблемы. Вызов функции или 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). Вы должны изменить расширение на .vbe после создания файла .txt.

И пегадатос: 

Sub pegadatos(TheSlide As Object)
TheSlide.Shapes.Paste.Select
End Sub
0 голосов
/ 12 июля 2019

Эта ошибка также может быть связана с ошибкой 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

0 голосов
/ 03 мая 2018

Часто 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
...