excel - 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 抛出“Range 类的运行时错误'1004'PasteSpecial 方法失败”。

调试：

“r.PasteSpecial”和“ps.Paste Destination:=r”都失败了。

dbg 变量包含 xlClipboardFormatPICT，因此数据似乎在那里并且检查剪贴板确认它。

我什至绝望地在复制和粘贴之间等待一整秒以消除竞争条件 - 粘贴通常在几乎相同数量的成功后失败。

我正在使用 Office 365 专业增强版。有趣的是它曾经在 v1705 上工作，但在 v1803 上却失败了。更有趣的是，在升级后的一段时间内它工作了，所以我不确定它是否仍然可以在以前的版本上工作......

标签： excelvba