Экспортировать выделение Excel (содержащее несколько графиков) в Outlook

Question

Я использую приведенный ниже код для экспорта определенного диапазона Excel в Outlook. Он работает очень хорошо и копирует все форматы и т. Д. Он даже помещает все графики в правильное положение, но, к сожалению, ни один из графиков не отображается должным образом:

Есть ли что-то, что я мог пропустить (возможно, отключенные макросы)? Все графики являются столбцовыми диаграммами, и я использую Office 2016 для Windows.

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
    .HTMLBody = fncRangeToHtml("Overview", "A5:W29")
    .Display
End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Function fncRangeToHtml( _
    strWorksheetName As String, _
    strRangeAddress As String) As String

    Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
    Dim strFilename As String, strTempText As String
    Dim blnRangeContainsShapes As Boolean

    strFilename = Environ$("temp") & "\" & _
        Format(Now, "dd-mm-yy_h-mm-ss") & ".htm"
    Debug.Print strFilename

    ThisWorkbook.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        fileName:=strFilename, _
        Sheet:=strWorksheetName, _
        Source:=strRangeAddress, _
        HtmlType:=xlHtmlStatic).Publish True

    Set objFilesytem = CreateObject("Scripting.FileSystemObject")
    Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
    strTempText = objTextstream.ReadAll
    objTextstream.Close
    strTempText = Replace(strTempText, "align=center x:publishsource=", "align=left x:publishsource=")

    For Each objShape In Worksheets(strWorksheetName).Shapes
        If Not Intersect(objShape.TopLeftCell, Worksheets( _
            strWorksheetName).Range(strRangeAddress)) Is Nothing Then

            blnRangeContainsShapes = True
            Exit For

        End If
    Next

    If blnRangeContainsShapes Then _
        strTempText = fncConvertPictureToMail(strTempText, Worksheets(strWorksheetName))

    fncRangeToHtml = strTempText

    Set objTextstream = Nothing
    Set objFilesytem = Nothing

    Kill strFilename
End Function

Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
    Const HTM_START = "<link rel=File-List href="
    Const HTM_END = "/filelist.xml"

    Dim strTemp As String
    Dim lngPathLeft As Long

    lngPathLeft = InStr(1, strTempText, HTM_START)

    strTemp = Mid$(strTempText, lngPathLeft, InStr(lngPathLeft, strTempText, ">") - lngPathLeft)
    strTemp = Replace(strTemp, HTM_START & Chr$(34), "")
    strTemp = Replace(strTemp, HTM_END & Chr$(34), "")
    strTemp = strTemp & "/"

    strTempText = Replace(strTempText, strTemp, Environ$("temp") & "\" & strTemp)

    fncConvertPictureToMail = strTempText
End Function