为什么工作表中导出的图片为空白？

anijoe123

写了个VBA过程，想把工作表中的图片，导出到指定文件夹。

代码如下：

1. Sub 导出图片()
   
2. '【导出图片 方法1】
   
3. Dim PTH$
   
4. 
   
5. PTH = ThisWorkbook.Path & "\导出图片"
   
6. If Dir(PTH, vbDirectory) = "" Then
   
7.         MkDir PTH '如果不存在，则创建文件夹
   
8. End If
   
9. 
   
10. For Each shp In ActiveSheet.Shapes
    
11.     If shp.Type = 11 Then
    
12.         shp.CopyPicture
    
13.             With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
    
14.                .Paste
    
15.                .Export PTH & shp.TopLeftCell.Offset(0, -2) & ".png"
    
16.                .Parent.Delete
    
17.             End With
    
18.      End If
    
19. Next
    
20. 
    
21. End Sub
    

复制代码

问题：
代码按F8逐条执行行，图片都能导入。


但按F5执行时，导出的图片是空白的。


是什么原因呢？

示例文件：
图片导出示例.rar (18.71 KB, 下载次数: 9)

2024-10-18 14:06 上传

点击文件名下载附件

quqiyuan

type=11是链接图片。13 是文件里的图片，你看取舍咯

yuyubiao

.Paste前面加一个.Activate

GG函数

若F8可以成功，一般是由于代码运行过快导致的，当每生成一张图片，需要加一句，等待1-2秒代码

大灰狼1976

不是说.paste前面加一句.parent.select可以解决吗，没试过

anijoe123

quqiyuan 发表于 2024-10-18 14:40
type=11是链接图片。13 是文件里的图片，你看取舍咯

加这句选中，可以非常感谢

anijoe123

大灰狼1976 发表于 2024-10-18 15:14
不是说.paste前面加一句.parent.select可以解决吗，没试过

可以。导出了

anijoe123

GG函数 发表于 2024-10-18 15:10
若F8可以成功，一般是由于代码运行过快导致的，当每生成一张图片，需要加一句，等待1-2秒代码

做程序处理工作，就是为了批量处理，越快越好，故意加延迟就不是我们的目的啦。
二楼的老师已经给出解决方案了

啦啦比比

问一下，导出来的都是略缩图来的

anijoe123

啦啦比比 发表于 2024-10-19 08:48
问一下，导出来的都是略缩图来的

导出的图片大小，就是你工作表中的图片大小。
你需要在工作表里调整好图片大小，再导出