VBA 把Excel中指定区域存储成图片，并把图片作为邮件正文向邮箱发送

需求是在EXCEl中，把sheet1和sheet2中指定区域，存储成为图片再向指定邮箱，作为正文发送，

Sub SaveRangeAsPictureAndEmail1()
Dim ws As Worksheet
Dim chartObj As ChartObject
Dim rng As Range
Dim imagePath As String
' 设置图片保存路径1
imagePath = "E:\图片\1月\RangeImage1.jpg"

' 导出 Sheet1 B2:M60 区域为图片
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("C23:K59")
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set chartObj = ws.ChartObjects.Add(rng.Left, rng.Top, rng.Width, rng.Height)
chartObj.Chart.Paste
chartObj.Chart.Export Filename:=imagePath
chartObj.Delete


    With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = "XXXXXXX@Outlook.com"
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .HTMLBody = RangetoHTML(rng)
    .send   'or use .Display
End With

On Error GoTo 0
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

' 导出 Sheet2 B2:P67 区域为图片
Set ws = ThisWorkbook.Sheets("Sheet2")
Set rng = ws.Range("B2:P67")
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set chartObj = ws.ChartObjects.Add(rng.Left, rng.Top, rng.Width, rng.Height)
chartObj.Chart.Paste
chartObj.Chart.Export Filename:=imagePath
chartObj.Delete

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = "XXXXXXXXX@Outlook.com"
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .HTMLBody = RangetoHTML(rng)
    .send   'or use .Display
End With
 On Error GoTo 0
    With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

' 清理
'Kill imagePath
End Sub