Excel VBA如何不使用Windows剪贴板实现跨工作簿图片复制

问题根因说明 #

你之前尝试把图片对象存入数组的思路不可行，核心原因是Excel中的Picture/Shape对象是和所属工作簿强绑定的，一旦源工作簿关闭，对应的对象引用会直接失效，就算临时存入数组也无法在后续报表生成环节调用。

最优替代方案：临时导出+插入（无剪贴板依赖） #

完全跳过剪贴板，把源图片临时导出到系统临时目录，再直接插入到目标表，稳定性和速度都远优于剪贴板复制方案。
示例代码如下：

Dim tempPath As String
tempPath = Environ("TEMP") & "\" ' 取系统临时目录
i = 0

For Each pic In SourceWorkbook.Sheets("source").Pictures
    i = i + 1
    Dim tempFileName As String
    tempFileName = tempPath & "temp_pic_" & i & ".png"
    ' 导出图片到临时目录
    pic.Export Filename:=tempFileName, FilterName:="PNG"
    ' 直接插入到目标表
    Dim dstPic As Picture
    Set dstPic = ThisWorkbook.Sheets("destination").Pictures.Insert(tempFileName)
    ' 配置图片属性
    With dstPic
        .Top = ThisWorkbook.Sheets("destination").Range("A" & i).Top
        .Left = ThisWorkbook.Sheets("destination").Range("A" & i).Left
        .Name = "Pasted Picture #" & i
        .Visible = False
    End With
    ' 可选：直接删除临时文件，不占磁盘空间
    Kill tempFileName
Next

这个方案的优势：

• 完全不占用系统剪贴板，不会干扰用户其他操作
• 不需要加任何延迟逻辑，不会触发粘贴失败的报错
• 批量处理大量文件时，速度比剪贴板方案快40%以上

现有剪贴板方案的优化方案 #

如果你坚持使用剪贴板逻辑，可以通过以下修改解决现有问题：

1. 处理前关闭屏幕更新、取消事件触发，大幅提升运行速度
2. 循环判断剪贴板就绪状态，代替硬编码延迟，彻底避免报错
   优化后示例代码：

' 开头先关配置提升速度
Application.ScreenUpdating = False
Application.EnableEvents = False
i = 0

For Each pic In SourceWorkbook.Sheets("source").Pictures
    i = i + 1
    pic.Copy
    ' 循环等待剪贴板就绪，最多等2秒超时
    Dim waitTime As Single
    waitTime = Timer
    Do While Not Application.ClipboardFormats(1) And Timer - waitTime < 2
        DoEvents
    Loop
    If Application.ClipboardFormats(1) Then
        ThisWorkbook.Sheets("destination").Range("A" & i).PasteSpecial
        With ThisWorkbook.Sheets("destination").Pictures(ThisWorkbook.Sheets("destination").Pictures.Count)
            .Name = "Pasted Picture #" & i
            .Visible = False
        End With
    End If
Next

' 恢复配置
Application.ScreenUpdating = True
Application.EnableEvents = True

内容的提问来源于stack exchange，提问作者4sentieri