Excel宏在新笔记本保存空白图片求助（Office2007升级至2021）

问题描述 #

此前编写的Excel宏可将指定文本框组保存为图片，在Windows7+Office2007环境下运行正常，但更换为Windows10+Office2021后，宏虽能运行却输出空白图片，原宏代码如下：

Set ws = ActiveSheet
Set shp = ws.Shapes.Range(Array("Group 191"))

Set ch = ws.ChartObjects.Add(shp.Left, shp.Top, shp.Width, shp.Height)
shp.Select
ch.Chart.ChartArea.Border.LineStyle = 0
Selection.Copy

ch.Chart.Paste
Set tt = ch.Chart
	tt.Export Filename:=ThisWorkbook.Path & "\KP2.png", filtername:="PNG"

ch.Delete

问题原因 #

Office 2016及后续版本（含2021）对选区复制、图表粘贴的机制做了调整，依赖Select和Selection的操作容易因焦点延迟、权限限制等问题导致复制未生效，最终粘贴空白内容。

解决代码 #

替换依赖选区的复制逻辑，直接使用形状对象的CopyPicture方法，修改后的宏代码如下：

Sub SaveGroupAsImage()
    Dim ws As Worksheet
    Dim shp As ShapeRange
    Dim ch As ChartObject
    Dim savePath As String
    
    Set ws = ActiveSheet
    Set shp = ws.Shapes.Range(Array("Group 191"))
    savePath = ThisWorkbook.Path & "\KP2.png"
    
    ' 创建与目标形状尺寸匹配的临时图表容器
    Set ch = ws.ChartObjects.Add(shp.Left, shp.Top, shp.Width, shp.Height)
    ch.Chart.ChartArea.Border.LineStyle = 0
    
    ' 直接复制形状为图片，不依赖选区
    shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    ' 粘贴到临时图表并导出为PNG
    ch.Chart.Paste
    ch.Chart.Export Filename:=savePath, Filtername:="PNG"
    
    ' 删除临时图表，清理界面
    ch.Delete
End Sub

关键修改说明 #

• 移除shp.Select和Selection.Copy，改用shp.CopyPicture直接操作形状对象，避免版本差异带来的选区失效问题。
• 明确CopyPicture的参数：Appearance:=xlScreen保证导出效果与屏幕显示一致，Format:=xlPicture指定复制为图片格式。
• 优化代码结构，增加变量可读性，减少不必要的中间对象赋值。

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