Excel VBA 指定区域内的数据 导出为图片

Sub ExportChart()
    Application.ScreenUpdating = False
    
    Dim ChartPath As String
    Dim range_str As String
    Dim file_str As String
    
    '需要保存为图片的区域
    range_str = "A2:C8"
    
    '保存为文件名为  2022-11-14.jpg
    file_str = "2022-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