粘贴图表时 VBA Excel 问题

问题描述

这是我第一次写信寻求帮助,如果有任何常规错误,我很抱歉,但我正在寻找一个多月的时间来解决我的问题,但在任何地方都找不到。

我有一个代码存储在我的团队的共享驱动器上。他们通过单击功能区上的不同按钮来运行 VBA 脚本来使用它,因此所有人都使用完全相同的宏。此外,它们的大多数本地环境变量都是相同的(其中一些添加了本地键盘,但卸载它们并不能解决问题)。相同的子程序每次在脚本中运行 13 次(13 个图表的 13 次迭代从不同的工作表复制以将它们收集在一个中)。

这是一个子:

Sub Movechart(TabName,ChartName,Pasterange)


Sheets(TabName).Activate

'this is to walk-over part of errors that were caused by not executing line above
If ActiveSheet.Name <> TabName Then
    Sheets(TabName).Select
End If

Range("a1").Select
ActiveSheet.Shapes(ChartName).copy
        
Sheets("MAIL").Select
Range(Pasterange).Select
ActiveSheet.Paste
ActiveSheet.Shapes(ChartName).IncrementTop 1
ActiveSheet.Shapes(ChartName).IncrementLeft 1

Application.CutcopyMode = False
End Sub

在少数计算机上执行此子程序时有时会导致错误。有些人在 13 次迭代中只遇到一次问题,其他几次,有些人从来没有。我自己也面临同样的错误,但不是每次运行脚本时。我注意到,当我测试一些更改并且在断点之前的任何地方时,它通常不会出错。

脚本本身非常庞大,模块很少,但自动化的过程需要手动花费 1 小时。

代码执行停止

ActiveSheet.Paste

部分停止是因为没有执行line

表格(TabName)。激活

所以我在代码中做了一个走动。其中一些仍在发生,导致此错误

运行时错误“1004”:Worksheet 类的粘贴方法失败

当我在那个地方停止宏并且我将手动尝试粘贴 (CTRL+V) 时,它会给我一个来自上一次迭代的图表,所以它看起来像是“跳过”执行行

ActiveSheet.Shapes(ChartName).copy

然后它得到了一些内部混杂错误,而不是实际错误提示中所写的内容

我想补充一点,机器非常强大,我们在每个虚拟机上都有 16GB 的内存。当我们从Win7-> Win10移动时开始出现错误,该脚本之前使用了很长时间没有问题。

我已经尝试过仅使用 4 个处理器中的 1 个以及仅帮助一个人的禁用剪贴板历史记录:)

您的帮助将不胜感激!

解决方法

非常感谢您的回答。 似乎结合了一个循环重复复制粘贴和

DoEvents

有帮助。这是现在的工作代码:

Sub Movechart(TabName,ChartName,PasteRange)
Dim Check As Integer

Check = 0
Do While Check < 20
    Sheets(TabName).Activate
    
    If ActiveSheet.Name <> TabName Then
        Sheets(TabName).Select
    End If
    
    Range("a1").Select
    ActiveSheet.Shapes(ChartName).Copy
            
    Sheets("MAIL").Select
    Range(PasteRange).Select
    On Error Resume Next
        ActiveSheet.Paste
        If Err.Number <> 0 Then
            DoEvents
            Check = Check + 1
            If Check > 19 Then
                MsgBox "Error with pasting charts,pls contact developer"
            End If
        Else
            Check = 20
            Exit Do
        End If
    On Error GoTo 0
Loop

ActiveSheet.Shapes(ChartName).IncrementTop 1
ActiveSheet.Shapes(ChartName).IncrementLeft 1

Application.CutCopyMode = False
End Sub