Sub ExportChart()
Application.ScreenUpdating = False
Dim ChartPath As String
Dim range_str As String
Dim file_str As String
'需要保存为图片的区域
range_str = "A2:C8"
'保存为文件名为 -11-14.jpg
file_str = "-11-14.jpg"
'保存路径 D:\ 路径可自已修改
ChartPath = "D:\" & file_str
'缩放尺寸 (缩放后图片更清晰)
ActiveWindow.Zoom = 200
Dim chtObject As ChartObject
' Sheet1 可更改为自己需要导出的 工作表 Sheet2/Sheet3......
With Sheet1
.Range(range_str).CopyPicture
Set chtObject = ActiveSheet.ChartObjects. _
Add(500, 100, .Range(range_str).Width, .Range(range_str).Height)
chtObject.Activate
chtObject.Chart.Paste
End With
On Error Resume Next
Kill ChartPath
chtObject.Chart.Export Filename:=ChartPath, Filtername:="JPG"
'删除chtObject的容器
chtObject.Activate
ActiveChart.Parent.Delete
'缩放尺寸
ActiveWindow.Zoom = 100
Set chtObject = Nothing
Application.ScreenUpdating = True
End Sub
