VBA宏生成工作表图片嵌入邮件后接收方无法显示求助

我参考另一线程《Paste specific worksheet range into email body》中Ron的VBA代码，修改后编写了Enviar_Abertura宏。该宏可调用Outlook新建邮件，将指定工作表「E-MAIL ABERTURA」的B6:F27区域转为图片嵌入邮件正文。但测试时发现，发送给自己和同事后，图片在Outlook客户端及网页端均无法正常显示，相关场景截图已附上，恳请各位帮忙解决。

宏代码如下： #

Sub Enviar_Abertura()

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim MakeJPG As String

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

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
          
MakeJPG = CopyRangeToJPG("E-MAIL ABERTURA", "B6:F27")

If MakeJPG = "" Then
    MsgBox "Something go wrong, we can't create the mail"
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Exit Sub
End If

On Error Resume Next
With OutMail
    .SentOnBehalfOfName = "teste@teste.com.br"
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = Planilha5.Range("B4")
    .Attachments.Add MakeJPG, 1, 0
    .HTMLBody = "<html><p>" & strbody & "</p><img src=""cid:NamePicture.jpg""></html>"
    .Display
End With
On Error GoTo 0

Kill MakeJPG

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
'Ron de Bruin, 25-10-2019
Dim PictureRange As Range

With ActiveWorkbook
    On Error Resume Next
    .Worksheets(NameWorksheet).Activate
    Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
    
    If PictureRange Is Nothing Then
        MsgBox "Sorry this is not a correct range"
        On Error GoTo 0
        Exit Function
    End If
    
    PictureRange.CopyPicture
    With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
    End With
    .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
End With

CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
Set PictureRange = Nothing
End Function

内容的提问来源于stack exchange，提问作者Gulkas