vba中Chart.Paste无法粘贴，图表区仍为空白

hnpdszhangduo

复制一些对象，其中包含一些图表。因为要将他们导出为文件，所以我进行以下操作：
1.选中这些对象
2.复制为图片
3.粘贴，仅用于获取宽度和高度
4.新建一个ChartObjects，宽高和上述相同
5.再次粘贴
6.用Chart.Export导出为文件

问题出在第五步，没有粘贴出图片，图表区仍为空白。即使加了暂停，也仍为空白。
但如果设置断点逐语句执行，图像会正常粘贴。

经过一些排查，我认为问题出在"图表 1.2"上。如果"图表 1.2"很简单（数据少），那么粘贴不为空白。
这种情况要怎么办？

附件在原文件的基础上进行了简化。
windows11，office2021。但之前使用office2019也出现了同样的问题。

1. Sub 保存为图片()
   
2. 
   
3.     路径 = "D:/test.bmp"
   
4.     If Dir(路径) <> "" Then
   
5.         Kill 路径
   
6.     End If
   
7.    
   
8.     '复制为图片
   
9.     Sheet_1_2.Select
   
10.     ActiveSheet.Shapes.Range(Array("图表 1.2", "文本框 1.2 标题", "文本框 1.2_1", "文本框 1.2_2")).Select
    
11.     Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    
12.    
    
13.     '粘贴图片，用于获取宽度。当Selection为ShpeRange（选择多个图表）时，Width属性不可用，所以要先存为图片再获取Width
    
14.     Worksheets("temp").Select
    
15.     Cells(1, 1).Select
    
16.     ActiveSheet.Paste
    
17.     宽度 = ActiveSheet.Shapes(1).Width
    
18.     高度 = ActiveSheet.Shapes(1).Height
    
19.    
    
20.     '将图片转存为图表，大小相同，为了使用export函数将图表导出为图片
    
21.     Set 图表 = ActiveSheet.ChartObjects.Add(0, 0, 宽度, 高度)
    
22.     图表.Chart.Parent.Select
    
23.     图表.Chart.Paste '该语句执行后，图表区仍为空白。设置断点后逐语句执行不为空白
    
24. '    Application.Wait (Now + TimeValue("00:00:02")) '暂停
    
25.     图表.Chart.Export 路径, "BMP"
    
26.     图表.Chart.Parent.Delete
    
27. 
    
28.     '删除所有图像
    
29.     ActiveSheet.Shapes.SelectAll
    
30.     Selection.Delete
    
31. 
    
32. End Sub
    

复制代码

yuyubiao

遇到同样的问题了，后面解决了吗？

yuyubiao

找到原因了，图表.Chart.Paste前面加一句图表.Chart.Activate 就可以了