运行时错误“1004”：Microsoft Excel 无法粘贴数据答案

【问题标题】：Run-time error '1004': Microsoft Excel cannot paste the data运行时错误“1004”：Microsoft Excel 无法粘贴数据
【发布时间】：2020-02-04 18:48:29
【问题描述】：

我查看了这个问题并看到了几个解决方案，例如选择或具有受保护的工作表，这些都不适用于我。

由于各种原因，我无法发布整个代码，但我会描述它的作用并发布给我带来问题的确切子代码。

我有一个宏，它根据用户输入的月份和年份（例如“1”-“31”或“1”-“30”等）生成许多工作表。为了生成这些工作表，宏会复制一个恰当地命名为“EXAMPLE”的工作表。复制的一件事是附有宏的图片（只是一个带有“导出”字样的矩形）。

我最近通过移动这张图片的位置做了我认为是外观上的改变，从那时起，当我运行宏时出现错误：

“运行时错误‘1004’： Microsoft Excel 无法粘贴数据。”

“结束”“调试”和“帮助”选项

如果我选择“调试”，它会将我指向在生成宏的过程中调用的第二个宏'

Sub CopyAllShapes()
Dim ws As Worksheet

' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")

' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a 
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
    If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
        Sheets("EXAMPLE").Shapes("Picture 1").Copy
        ws.Range("J62").PasteSpecial
        ws.Shapes("Picture 1").OnAction = "Export"
    End If
Next ws

Application.CutCopyMode = xlCopy
End Sub

Debug 选项突出显示该行

ws.Range("J62").PasteSpecial

真正让我感到困惑的是，如果我选择“结束”而不是“调试”，宏会停止，但所有工作表都已粘贴图片以及分配的导出宏，并且一切都按预期工作。如果我是唯一一个使用这个的人，那将是一个小麻烦，但是这个文档被许多不能可靠地被告知“忽略”错误的人使用。由于宏按预期运行，我该如何解决导致问题的原因并使错误消失？

正如我所说，我不能发布整个宏，但如果有人需要更多信息，我可以发布一些零碎的信息。

【问题讨论】：

我运行代码并添加了一个名为“图片 1”的形状，它对我来说粘贴得很好。
把它移回去有用吗？
@PeterT 将其移回并不是一个真正的选择，因为我必须调整单元格。但是，我仍然保存了工作簿预先更改的副本，并且在那里运行良好。
@BrandonMurphy - Dim ws as Worksheet 是正确的选择。
@BrandonMurphy 正如我所说，某些在 Excel 2016 中有效的东西在 2013 年无效。有时只是因为错误，我猜。即使没有，改变看似不重要的事情（对于像我这样的新手）可能会有所帮助。当出现类似错误时，我通常会稍微更改代码。也许试试这个approach。而不是 'ws.Range("J62").PasteSpecial'，我会添加三行 'Set myPic = ws.Pictures.Paste', 'myPic.Left = ws.Range("J62").Left', 'myPic .Top = ws.Range("J62").Top' 并声明 myPic 为图片。

标签： excel vba

【解决方案1】：

在迁移到 Office 365 和 Win10 时（不能说是罪魁祸首），我发现了一堆现有的宏，当尝试将复制的图像粘贴到工作表上时，它们会出现同样的错误。

进入调试时，“粘贴”行会突出显示，但如果我点击“继续”，它会（经过一两次尝试）运行而没有错误。

我最终这样做了：

'paste problem fix
Sub PastePicRetry(rng As Range)
    Dim i As Long
    Do While i < 20
        On Error Resume Next
        rng.PasteSpecial
        If Err.Number <> 0 Then
            Debug.Print "Paste failed", i
            DoEvents
            i = i + 1
        Else
            Exit Do
        End If
        On Error GoTo 0
        i = i + 1
    Loop
End Sub

...这看起来有点矫枉过正，但却是解决问题的唯一可靠方法。

编辑：清理并重构为独立的子。

【讨论】：

你把这个放在哪里了？就在我上面发布的代码之后？此外，我需要这个循环的次数会因月份而异（例如本月 29 次），因此对于“如果 i > 20 然后退出执行”的行，我可以将其替换为“如果我>Days Then Exit Do" 我将 Days 设置为从单元格中提取的变量？
@tim 这将使 OERN 在粘贴时保持活动状态？
@chrisneilsen - 很确定 OERN 不会“向上”到达调用代码，但我会仔细检查
@tim 并不是暗示它“向上移动”（它没有）。如果这是 Sub 的全部内容，那么这里没有问题。

【解决方案2】：

只是想让大家知道我找到了（某种）解决方案。根据 Tim Williams 和 PeterT 的答案/cmets，我将代码修改为如下所示：

Sub CopyAllShapes()
Dim ws As Worksheet

' Sets the non-generated worksheets as an array
nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")

' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a 
' seperate Macro called "Export" to the picture on each of these sheets.
For Each ws In ActiveWorkbook.Worksheets
    If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
        Sheets("EXAMPLE").Shapes("Picture 1").Copy
    On Error Resume Next
        ws.Range("J62").PasteSpecial
    On Error Goto 0
        ws.Shapes("Picture 1").OnAction = "Export"
    End If
Next ws

Application.CutCopyMode = xlCopy
End Sub

这已成功忽略错误，现在一切正常！感谢大家的帮助，希望这对以后的其他人有所帮助！

【讨论】：

如果粘贴失败，下一个OnAction 行是否失败？
@TimWilliams 它并没有出现。这就是对此感到困惑的原因，实际上根本没有失败，我只是不断收到错误消息说它确实失败了。所以也许如果粘贴失败，那么 OnAction 也会失败，但据我所知，它实际上从未失败过。

【解决方案3】：

不是纯粹的修复，但如果失败（最多 3 次），此代码将重试复制/粘贴，而不是直接删除它：

Const MaxRetries AS Long = 3

Sub CopyAllShapes()
    Dim ws As Worksheet
    Dim TimesRetried As Long

    ' Sets the non-generated worksheets as an array
    nSheets = Array("EXAMPLE", "Weekly Totals", "Menu")

    ' Copies the Picture from the EXAMPLE sheet to all worksheets not in the array and then assigns a 
    ' seperate Macro called "Export" to the picture on each of these sheets.
    For Each ws In ActiveWorkbook.Worksheets
        If Not IsNumeric(Application.Match(ws.Name, nSheets,0)) Then
            TimesRetried = 0
CopyExampleShape:
            On Error Resume Next
            Sheets("EXAMPLE").Shapes("Picture 1").Copy
            ws.Range("J62").PasteSpecial
            'If the Copy/Paste fails, retry
            If Err Then
                On Error GoTo -1 'Clear the Error
                'Don't get stuck in an infinite loop
                If TimesRetried < MaxRetries Then
                    'Retry the Copy/paste
                    TimesRetried = TimesRetried + 1
                    DoEvents
                    GoTo CopyExampleShape
                End If
            End If
            On Error GoTo 0
            ws.Shapes("Picture 1").OnAction = "Export"
        End If
    Next ws

    Application.CutCopyMode = xlCopy
End Sub

我之前遇到过类似的问题，这是由于另一个程序（在一种情况下是 Skype）通过“检查”来对添加到剪贴板的数据做出反应。然后短暂锁定剪贴板，因此Paste/PasteSpecial 操作失败。这然后导致剪贴板被擦除干净......所有这些都没有 Excel 做错任何事情。

"It is possible to commit no mistakes and still lose. That is not a weakness; that is life." ~ Jean-Luc Picard

【讨论】：