Range.PasteSpecial вызывает ошибку времени выполнения «1004»

Question

Требование:

У нас есть график со значительным количеством элементов в фильтрах.Пользователь хочет одним щелчком мыши распечатать все перестановки.

Моя идея:

Выполнить итерацию всего, настроить фильтры и отобразить диаграмму как изображение на одном листе (к сожалению, я не нашелспособ сделать это без буфера обмена).

Решение:

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Sub PrintButton_Click()
    Dim ps As Worksheet
    Dim gs As Worksheet
    Dim r As Range
    Dim c As ChartObject
    Dim s As Shapes
    Dim n As Integer

    Application.ScreenUpdating = False

    Set gs = Sheets("Graph")
    Set ps = gs
    Set c = gs.ChartObjects("Chart")

    n = 0
    For Each loopRow In Sheets("Klassen").UsedRange.Rows
        ' there seems to be 1024 PageBreaks per Sheet limit
        If n Mod 1024 = 0 Then
            Set ps = Sheets.Add(After:=ps)
            ps.Name = "Print" + IIf(n / 1024 = 0, "", "_" + CStr(n / 1024))
            ps.PageSetup.Orientation = xlLandscape
            Set s = ps.Shapes
            Set r = ps.Cells(1, 1)
        End If

        If loopRow.Row <> 1 And loopRow.Cells(1).Value <> "" And loopRow.Cells(2).Value <> "" Then
            gs.Cells(1, 2).Value = loopRow.Cells(1).Value
            gs.Cells(2, 2).Value = loopRow.Cells(2).Value

            c.CopyPicture
            DoEvents

            'Sleep 1000
            'DoEvents

            'EnsureClipboard (xlClipboardFormatPICT)
            'dbg = Application.ClipboardFormats(1)

            r.PasteSpecial
            'ps.Paste Destination:=r

            Set r = ps.Cells(s(s.Count).BottomRightCell.Row + 1, 1)
            r.PageBreak = xlPageBreakManual

            'gs.Cells(1, 1).Copy
            'EnsureClipboard (xlClipboardFormatText)
        End If

        n = n + 1
    Next

    gs.Cells(1, 2).Value = "(All)"
    gs.Cells(2, 2).Value = "(All)"

    Application.ScreenUpdating = True

End Sub

Sub EnsureClipboard(desiredFmt As XlClipboardFormat)
    Dim present As Boolean

    DoEvents
    present = False
    Do While Not present
        aFmts = Application.ClipboardFormats
        For Each fmt In aFmts
            If fmt = desiredFmt Then
                present = True
            End If
        Next
        If Not present Then
            DoEvents
            Sleep 100
            DoEvents
        End If
    Loop
End Sub

Проблема:

После переменного количества итераций Excel выдает «Ошибка времени выполнения»'1004' Метод PasteSpecial класса Range не выполнен ".

Отладка:

Сбой как" r.PasteSpecial ", так и" ps.Paste Destination: = r ".

dbgпеременная содержит xlClipboardFormatPICT, поэтому кажется, что данные есть, и проверка буфера обмена подтверждает это.

Я даже отчаянно пытался подождать целую секунду между копированием и вставкой, чтобы устранить условие гонки - вставка обычно завершается неудачно после значительнойстолько же успехов.

Я использую Office 365 ProPlus.Забавно то, что раньше он работал на v1705, он не работает на v1803.Еще забавнее то, что какое-то время после обновления оно работало, поэтому я не уверен, будет ли оно работать в предыдущей версии ...