代码:Sub ExportImagesFromCurrentWorkbook()
Dim i As Integer ' 用于遍历工作簿中的工作表索引
Dim k As Integer ' 用于为导出的图片文件命名
Dim sheet As Worksheet ' 用于引用当前处理的工作表
Dim shape As shape ' 用于引用当前处理的图形对象
Dim chartObj As ChartObject ' 用于创建并引用图表对象
' 关闭屏幕更新,以提高代码执行效率
Application.ScreenUpdating = False
' 初始化图片命名计数器
k = 0
' 开始处理当前工作簿
With ThisWorkbook
' 遍历工作簿中的所有工作表
For i = 1 To .Sheets.Count
Set sheet = .Sheets(i)
' 遍历当前工作表中的所有图形对象
For Each shape In sheet.Shapes
' 为导出的图片增加计数
k = k + 1
' 复制图形对象到剪贴板
shape.Copy
' 在工作表上创建一个新的图表对象,大小与图形对象相同
Set chartObj = sheet.ChartObjects.Add(0, 0, shape.Width, shape.Height)
' 将剪贴板的内容粘贴到图表对象中
With chartObj.Chart
.Paste
' 导出图表对象为 PNG 图片,文件名包含工作簿名和图片序号
.Export ThisWorkbook.Path & "\" & .Parent.Name & "_" & k & ".png"
End With
' 删除图表对象,释放资源
chartObj.Delete
Next shape
Next i
End With
' 恢复屏幕更新
Application.ScreenUpdating = True
End Sub