为什么使用Excel宏复制粘贴形状时会出现自动错误，但如果我减慢代码速度，则不会出现这种错误？

当我尝试根据单元格的值将某些现有形状复制粘贴到单元格中时，我的宏在复制几次（少于10次）后将失败，并出现以下错误：

运行时错误“-2147221040（800401d0）”：自动化错误 OpenClipboard失败

我最初认为这可能是某种剪贴板缓冲区问题，因此在每次粘贴后添加了以下命令：

Application.CutCopyMode = False

但这并没有改变任何事情

但后来我注意到，如果在我的代码上设置一些断点并“一步一步”地运行它（当在断点处时为F5），它就可以正常工作。。。只要我不太快按F5

最后，我在每次粘贴后添加了1s的等待，这样代码就可以毫无错误地运行到最后（但是对于几千次粘贴来说速度非常慢）

下面是我当前运行的代码：

Sub Change_to_icon()
Dim cell As Range

For Each cell In ActiveSheet.Range("C4:AI28")
    If cell.Value = "" Then
        cell.Value = "0"
    ElseIf cell.Value = "1" Then
        ActiveSheet.Shapes("CD").Copy
        cell.Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Application.Wait (Now + TimeValue("0:00:01"))
    ElseIf cell.Value = "2" Then
        ActiveSheet.Shapes("CDW").Copy
        cell.Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Application.Wait (Now + TimeValue("0:00:01"))
    ElseIf cell.Value = "3" Then
        ActiveSheet.Shapes("E").Copy
        cell.Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Application.Wait (Now + TimeValue("0:00:01"))
    ElseIf cell.Value = "4" Then
        ActiveSheet.Shapes("CT").Copy
        cell.Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Application.Wait (Now + TimeValue("0:00:01"))
    End If


Next cell

End Sub

在其他一些主题中，有人建议在一些非常类似的情况下，而不是在循环中出现差异，例如尝试在复制之前粘贴（我很理解），并添加一些事件。我也在代码中的不同地方尝试过这个。没有改变任何事情

此外，粘贴的所有新形状都有相似的名称，我可以想象它在某些地方有一些意想不到的副作用，但我没有尝试为每个粘贴给它们一个新名称

---

当它在没有等待的情况下全速运行时，你认为会发生什么

您可以使用

Shape.Duplicate

，而不是复制粘贴。以下代码在我的计算机上复制了1000多个形状，不到2秒：

With ActiveSheet

    Dim cell As Range
        For Each cell In .Range("C4:AI28")

        Dim shapeName As String
        shapeName = ""

        Select Case cell.Value
            Case 0: cell.Value = 1
            Case 1: shapeName = "CD"
            Case 2: shapeName = "CDW"
            (...)
        End Select

        If shapeName <> "" Then
            Dim shCopy As Shape
            Set shCopy = .Shapes(shapeName).Duplicate
            shCopy.Left = cell.Left
            shCopy.Top = cell.Top
            shCopy.Name = shapeName & "_" & cell.Address(False, False)
        End If
    Next cell
End With

使用ActiveSheet的

暗淡单元格作为范围
对于范围内的每个单元格（“C4:AI28”）
将shapeName设置为字符串
shapeName=“”
选择大小写单元格。值
案例0：单元格。值=1
案例1:shapeName=“CD”
案例2:shapeName=“CDW”
(...)
结束选择
如果是shapeName“”，则
按形状复制
设置shCopy=.Shapes（shapeName）.重复
shCopy.Left=单元格.Left
shCopy.Top=单元格.Top
shCopy.Name=shapeName&“&”cell.Address（False，False）
如果结束
下一个细胞
以