Excel VBA复制和粘贴许多形状现在在Windows 10中出错，但在2016年没有

Question

我在VBA方面有点新手，但总是从阅读论坛中找到解决方案。

我现在有一个问题无法解决，我的公司最近从Windows 2016切换到了Windows 10(幸运的是，目前我仍然有两台笔记本电脑(，但我的代码在旧版本中开发的一些Excel VBA工具中出现了不一致的错误。

我的同事也有这个问题，但他通过禁用和启用丢失的库来解决了这个问题。。我试过了，但没有解决。

错误。。

基本上我的工具"；绘制"；通过复制和粘贴形状、调整形状大小以及在指定的单元格位置重命名形状来显示项目的甘特图。。以前的版本一点问题都没有，只需几秒钟。。Windows 10完全不一致。。有时它会毫无问题地运行(比如说20%的时间(，然后它会在代码的不同区域出错！

我得到的错误是"；运行时错误1004工作表类的粘贴方法失败"；

我不知道为什么我的代码会在旧的Windows中运行find，而不是在Windows 10中。但这可能是因为我的代码有点垃圾，选择形状和单元格等，有时它无法处理？

下面是我正在使用的代码的一个例子，任何建议都将不胜感激：

Sub DrawDevelopment()
Dim rngData As Range
Set rngData = Sheets("Gantt Extract").Range("a4:a300")
For Each G In rngData

G_Address = G.Offset(0, 39).Value
G_size = G.Offset(0, 40).Value
G_Scheme = G.Offset(0, 1).Value
If G_Address <> "" Then
Sheets("Gantt").Shapes("Development").Select
Selection.Copy
Range(G_Address).Select
Sheets("Gantt").Paste
Selection.Name = "Delete" & (G_Scheme)
With Selection.ShapeRange
.Width = G_size
Selection.ShapeRange.IncrementTop 4

Selection.ShapeRange.ZOrder msoBringToFront

End With
End If
Next G

End Sub

使用形状绘制总体代码的示例

Answer 1

虽然不是Windows 10特有的，但这里使用不合格的Select语句可能会导致问题。

我试着在没有Select的情况下重新编写它，但为了测试它，我不得不去掉ShapeRange的用法，然后它才能使用我的形状。

可能有更好的方法来参考粘贴的形状，但我无法立即看到，所以这看起来确实有点乱，但在我的Win10机器上有效：

Sub DrawDevelopment()
Dim rngData As Range

Dim shtCopyFrom As Worksheet
Dim shtCopyTo As Worksheet

Set shtCopyFrom = Sheets("Gantt")
Set shtCopyTo = Sheets("Gantt Extract")
Set rngData = shtCopyTo.Range("a4:a300")

For Each g In rngData.Cells
G_Address = g.Offset(0, 39).Value
G_size = g.Offset(0, 40).Value
G_Scheme = g.Offset(0, 1).Value
If G_Address <> "" Then
shtCopyFrom.Shapes("Development").Copy
With shtCopyTo
.Paste
Set objShape = .Shapes(.Shapes.Count)
objShape.Name = "Delete" & (G_Scheme)
Set pasteCell = .Range(G_Address)
With objShape
.Width = G_size
.IncrementTop 4
.ZOrder msoBringToFront
.Left = pasteCell.Left
.Top = pasteCell.Top
End With
End With
End If
Next g
End Sub