vba 运行时错误 1004 工作表的粘贴方法失败（尝试从剪贴板粘贴）

Run-time Error 1004 Paste Method of Worksheet Failed (Trying to Paste from Clipboard)

提问by jj_searcher

(Excel VBA 2007). I'm getting an error in code generated by a macro - Excel wrote the code, so why won't it run?

（Excel VBA 2007）。我在宏生成的代码中遇到错误 - Excel 编写了代码，为什么它不能运行？

Some background: Within my VBA application, I am trying to copy a worksheet with a formatted pivot table and paste it into a new workbook, keeping the formatting, but not links to the source data. A simple 'Paste' includes the source data. A 'Paste Special' with values and then formats doesn't bring across PivotTable formats.

一些背景：在我的 VBA 应用程序中，我试图复制带有格式化数据透视表的工作表并将其粘贴到新工作簿中，保留格式，但不链接到源数据。简单的“粘贴”包括源数据。带有值和格式的“特殊粘贴”不会跨越数据透视表格式。

I found a post http://blog.contextures.com/archives/2010/09/22/copy-pivot-table-format-and-values/which explains how to manually do this - paste in from the Clipboard. This works when done manually.

我找到了一篇文章http://blog.contextures.com/archives/2010/09/22/copy-pivot-table-format-and-values/，其中解释了如何手动执行此操作 - 从剪贴板粘贴。这在手动完成时有效。

I recorded a macro and it generated the following code:

我录制了一个宏，它生成了以下代码：

Sub PivotCopyPaste()
'
' PivotCopyPaste Macro
'

'  Aim:  Open a workbook with a pivot table report on the first sheet.
'  Create a new workbook and paste the pivot table in, without
'  pivot source data, but keeping pivot formatting

Workbooks.Open Filename:="\MyServer\MyFolder\PivotReport.xls"
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
'I think the line below forces the paste from the Clipboard
Application.CutCopyMode = False
ActiveSheet.Paste   'ERRORS on this line

End Sub

When I run this 'as is', I get an error: "Run-Time Error 1004: Paste method of Worksheet class failed" on the ActiveSheet.Pasteline.

当我按原样运行此程序时，在ActiveSheet.Paste行上出现错误：“运行时错误 1004：Worksheet 类的粘贴方法失败” 。

If I take out the Application.CutCopyMode = Falseline, the macro runs, but it pastes in the Source Data (i.e. it's still an active PivotTable) - not what I want.

如果我取出Application.CutCopyMode = False行，宏会运行，但它会粘贴源数据（即它仍然是一个活动的数据透视表）——这不是我想要的。

I have found lots of references to this error - including http://www.mrexcel.com/forum/excel-questions/387000-runtime-error-1004-a.html.

我发现很多对此错误的引用 - 包括http://www.mrexcel.com/forum/excel-questions/387000-runtime-error-1004-a.html。

They suggest the clipboard may be empty. I have the clipboard pane visible in Excel and it shows something is there.

他们建议剪贴板可能是空的。我在 Excel 中可以看到剪贴板窗格，它显示了一些东西。

They suggest putting explicit references to the old and new sheets/ranges so that they can be referenced by variable rather than relying on the correct one being 'Active' - I tried that and it didn't make much difference (just changed the text of the error message to " Method 'Paste' of object '_Worksheet' failed".

他们建议对旧的和新的工作表/范围进行显式引用，以便它们可以被变量引用，而不是依赖于正确的“活动”——我试过了，但没有太大区别（只是改变了“对象'_Worksheet'的方法'粘贴'失败”的错误消息。

Is it possible to do what I am trying to do? If so, how? All help gratefully received.

有可能做我想做的事吗？如果是这样，如何？感激地收到所有帮助。

{Follow-up: on the same blog, Debra provides some code to paste in the data/formats for a pivot table: I can't paste the link here - not enough reputation yet - but I've included the link in my comment to @Rory below.

{后续：在同一个博客上，Debra 提供了一些代码来粘贴数据透视表的数据/格式：我无法在此处粘贴链接 - 声誉还不够 - 但我已将链接包含在我的评论中到下面的@Rory。

This allows me to paste each pivot table individually, but there are other elements on each report, different each time, such as company logo, (optionally) hidden rows containing the pivot table filters, Titles etc. I was really after a 'paste everything on the sheet' solution to make my code simple! }

这允许我单独粘贴每个数据透视表，但是每个报告上还有其他元素，每次都不同，例如公司徽标，（可选）包含数据透视表过滤器、标题等的隐藏行。我真的是在“粘贴所有内容”之后在工作表的解决方案上，使我的代码变得简单！}

回答by Rory

I haven't done a lot of testing but try this - it should just paste whatever was copied, including pictures, but leaves pivot tables as a static range with formatting:

我没有做过很多测试，但试试这个 - 它应该只粘贴复制的任何内容，包括图片，但将数据透视表保留为带有格式的静态范围：

Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" ( _
                                                ByVal wFormat As Long, ByVal lpString As String, _
                                                ByVal nMaxCount As Long) As Long

Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" ( _
                                 ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" ( _
                                 ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long

Sub PasteAsLocalFormula()
'If the clipbaord contains an Excel range, any formula is pasted unchanged, moving sheet and _
  cell references to the destination workbook.
    Dim S                     As String
    Dim i As Long, CF_Format  As Long
    Dim SaveDisplayAlerts As Boolean, SaveScreenUpdating As Boolean
    Dim HTMLInClipBoard       As Boolean
    Dim Handle As Long, Ptr As Long, FileName As String

    'Enumerate the clipboard formats
    If OpenClipboard(0) Then
        CF_Format = EnumClipboardFormats(0&)
        Do While CF_Format <> 0
            S = String(255, vbNullChar)
            i = GetClipboardFormatName(CF_Format, S, 255)
            S = Left(S, i)
            HTMLInClipBoard = InStr(1, S, "HTML Format", vbTextCompare) > 0

            If HTMLInClipBoard Then
                Handle = GetClipboardData(CF_Format)
                Ptr = GlobalLock(Handle)
                Application.CutCopyMode = False
                S = Space$(lstrlen(ByVal Ptr))
                lstrcpy S, ByVal Ptr
                GlobalUnlock Ptr
                SetClipboardData CF_Format, Handle
                ActiveSheet.PasteSpecial Format:="HTML"
                Exit Do
            End If

            CF_Format = EnumClipboardFormats(CF_Format)
        Loop
        CloseClipboard
    End If

End Sub

回答by AjV Jsy

Adding this here as it's the first StackOverflow link served up by Google for the error "Paste method of worksheet class failed".

在这里添加它，因为它是 Google 为“工作表类的粘贴方法失败”错误提供的第一个 StackOverflow 链接。

It seems that this error can occur when Excel isn't ready to paste. I had the error occur sporadically when copying one of a set of logo images by VBA from a hidden sheet into the main sheet. In the end I found that my code seems a lot more robust after adding a
Do While Not Application.Ready: Sleep 10: Loopimmediately before the .Copy and also between the subsequent .Select and .Paste. This required placing
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)up at the top of the module, of course. I also have a DoEventsafter the .Copy (following an earlier suggestion I'd found somewhere), and that seems to help too. I haven't seen the error since, FWIW :)

当 Excel 尚未准备好粘贴时，似乎会发生此错误。在将 VBA 的一组徽标图像中的一个从隐藏工作表复制到主工作表时，偶尔会发生错误。最后，我发现
Do While Not Application.Ready: Sleep 10: Loop在 .Copy 之前以及随后的 .Select 和 .Paste 之间添加一个后，我的代码似乎更加健壮。当然，这需要放置
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)在模块的顶部。我DoEvents在 .Copy 之后也有一个（遵循我在某处找到的早期建议），这似乎也有帮助。我没有看到错误，FWIW :)

UPDATE - I still had errors from time to time, so I resorted to error trapping along the lines of the following. The TryLogoAgain: label goes before the earlier .Copy (not shown) because it seems to be the .Copy that has failed to work, leaving the .Paste to fail (retrying just the .Paste over and over again never worked).

更新 - 我仍然不时出现错误，所以我采取了以下方式的错误捕获。TryLogoAgain: 标签位于较早的 .Copy （未显示）之前，因为它似乎是 .Copy 失败了，而 .Paste 失败了（一遍又一遍地重试 .Paste 从未奏效）。

On Error Resume Next
Worksheets(1).Paste Destination:=Worksheets(1).Range("B1")
If Err.Number <> 0 Then Err.Clear: MsgBox "Excel is struggling to copy something, trying again...": Sleep (10): GoTo TryLogoAgain

So far it has always managed to work on the second try! (Excel 2010 btw)

到目前为止，它总是设法在第二次尝试中工作！（顺便说一下，Excel 2010）