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 ProPlus。有趣的是它曾经在v1705上运行，在v1803上失败。更有趣的是，它在升级后的一段时间内仍然有效，所以我不确定它是否仍可以在以前的版本上使用。

Range.PasteSpecial原因导致运行时错误'1004'

0 个答案: