Question

（Excel VBA 2007）。我在宏生成的代码中出错--Excel编写代码，为什么不运行？

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

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

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

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

当我'按原样'运行时，我得到一个错误： ActiveSheet.Paste 行上的“运行时错误1004：Worksheet类的粘贴方法失败”。

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

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

他们建议剪贴板可能为空。我在Excel中显示了剪贴板窗格，它显示了一些内容。

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

有可能做我想做的事吗？如果是这样，怎么样？感谢所有的帮助。

{跟进：在同一个博客上，Debra提供了一些代码来粘贴数据透视表的数据/格式：我不能在这里粘贴链接 - 还没有足够的声誉 - 但我已经包含了链接在我对@Rory下面的评论中。

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

Answer 1

我还没有做过很多测试，但是尝试一下 - 它应该只是粘贴复制的内容，包括图片，但是将数据透视表作为带有格式的静态范围：

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

Answer 2

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

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

更新 - 我仍然不时有错误，所以我采取了错误捕获的方式沿着以下方向。 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

到目前为止，它总是设法第二次尝试！（Excel 2010 btw）

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

2 个答案: