Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/16.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 运行时错误1004工作表的粘贴方法失败(尝试从剪贴板粘贴)_Vba_Excel - Fatal编程技术网

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

Vba 运行时错误1004工作表的粘贴方法失败(尝试从剪贴板粘贴),vba,excel,Vba,Excel,(Excel VBA 2007)。我在宏生成的代码中遇到了一个错误-Excel编写了代码,为什么它不能运行 一些背景: 在我的VBA应用程序中,我试图复制一个带有格式透视表的工作表,并将其粘贴到新工作簿中,保留格式,但不保留到源数据的链接。简单的“粘贴”包括源数据。带有值和格式的“特殊粘贴”不会带来数据透视表格式 我发现了一篇文章,解释了如何手动执行此操作-从剪贴板粘贴。这在手动完成时有效 我录制了一个宏,它生成了以下代码: Sub PivotCopyPaste() ' ' PivotCopyP

(Excel VBA 2007)。我在宏生成的代码中遇到了一个错误-Excel编写了代码,为什么它不能运行

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

我发现了一篇文章,解释了如何手动执行此操作-从剪贴板粘贴。这在手动完成时有效

我录制了一个宏,它生成了以下代码:

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:工作表类的粘贴方法失败”

如果我取出Application.CutCopyMode=False行,宏将运行,但它会粘贴到源数据中(即,它仍然是一个活动的数据透视表)-这不是我想要的

我发现了很多关于这个错误的参考资料,包括

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

他们建议将显式引用放在新旧工作表/范围上,这样它们就可以被变量引用,而不是依赖“活动”的正确工作表-我试过了,但没有多大区别(只是将错误消息的文本更改为对象的“方法”“粘贴”“失败”)

有可能做到我想做的事情吗?如果有,怎么做?感谢所有的帮助

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


这允许我单独粘贴每个数据透视表,但每个报表上都有其他元素,每次都不同,例如公司徽标,(可选)包含数据透视表过滤器、标题等的隐藏行。我真的想通过“将所有内容粘贴到工作表上”解决方案来简化代码!}

我没有做过很多测试,但尝试一下-它应该只粘贴复制的内容,包括图片,但将透视表保留为静态范围,并带有格式:

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
私有声明函数OpenClipboard Lib“user32.dll”(ByVal hwnd As Long)尽可能长
私有声明函数CloseClipboard Lib“user32.dll”(长度为
私有声明函数EnumClipboardFormats Lib“user32”(ByVal wFormat As Long)的长度
私有声明函数GetClipboardFormatName Lib“user32”别名“GetClipboardFormatNameA”(_
ByVal wFormat为长,ByVal lpString为字符串_
ByVal nMaxCount As Long)As Long
私有声明函数SetClipboardData Lib“user32”(ByVal wFormat As Long,ByVal hMem As Long)As Long
私有声明函数GetClipboardData Lib“user32.dll”(ByVal wFormat作为Long)作为Long
私有声明函数GlobalLock Lib“kernel32.dll”(ByVal hMem As Long)为Long
私有声明函数GlobalUnlock Lib“kernel32.dll”(ByVal hMem As Long)为Long
私有声明函数lstrlen Lib“kernel32.dll”别名“lstrlenA”(_
ByVal lpString As Long)As Long
私有声明函数lstrcpy Lib“kernel32.dll”(_
ByVal lpStr1(如有)和ByVal lpStr2(如有)一样长
子PasteAsLocalFormula()
'如果clipbaord包含Excel范围,则任何公式都将粘贴不变,并移动工作表和_
目标工作簿的单元格引用。
像线一样变暗
尺寸i尽可能长,CF_格式尽可能长
Dim SaveDisplayAlerts为布尔值,SaveScreen更新为布尔值
将剪贴板设置为布尔值
Dim句柄为长,Ptr为长,文件名为字符串
'枚举剪贴板格式
如果打开剪贴板(0),则
CF_Format=EnumClipboardFormats(0&)
当CF_格式为0时执行
S=字符串(255,vbNullChar)
i=GetClipboardFormatName(CF_格式,S,255)
S=左(S,i)
HTMLInClipBoard=InStr(1,S,“HTML格式”,vbTextCompare)>0
如果你喜欢剪贴板的话
Handle=GetClipboardData(CF_格式)
Ptr=GlobalLock(手柄)
Application.CutCopyMode=False
S=空间$(lstrlen(ByVal Ptr))
lstrcpy S,ByVal Ptr
GlobalUnlock Ptr
SetClipboardData CF_格式,句柄
ActiveSheet.Paste特殊格式:=“HTML”
退出Do
如果结束
CF_格式=枚举剪贴板格式(CF_格式)
环
关闭剪贴板
如果结束
端接头

我没有做过很多测试,但尝试一下-它应该只粘贴复制的任何内容,包括图片,但将透视表保留为静态范围,并带有格式:

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
私有声明函数OpenClipboard Lib“user32.dll”(ByVal hwnd As Long)尽可能长
私有声明函数CloseClipboard Lib“user32.dll”(长度为
私有声明函数EnumClipboardFormats Lib“user32”(ByVal wFormat As Long)的长度
私有声明函数GetClipboardFormatName Lib“user32”别名“GetClipboardFormatNameA”(_
ByVal wFormat为长,ByVal lpString为字符串_
ByVal nMaxCount As Long)As Long
私有声明函数SetClipboardData Lib“user32”(ByVal wFormat As Long,ByVal hMem As Long)As Long
私有声明函数GetClipboardData Lib“user32.dll”(ByVal wFormat作为Long)作为Long
私有声明函数GlobalLock Lib“kernel32.dll”(ByVal hMem As Long)为Long
私有声明函数GlobalUnlock Lib“kernel32.dll”(ByVal hMem As Long)为Long
私有声明函数lstrlen