Function ConvertRngToHTM(rng As Range)
    Dim resHTM As String
    dx = rng.Value
    resHTM = " <style type='text/css' >" & _
             "table tbody tr th {background-color: #90c9e1;border: 1px solid #767777 ;}" & _
             "table tbody tr td {border: 1px solid #767777 ;}</style>"
    resHTM = resHTM & "<table border=0 style='border-collapse:collapse'><tbody>"
    For r = 1 To UBound(dx)
        resHTM = resHTM & "<tr>"
        For c = 1 To UBound(dx, 2)
            If r = 1 Then
                resHTM = resHTM & "<th>" & dx(r, c) & "</th>"
            Else
                resHTM = resHTM & "<td>" & dx(r, c) & "</td>"
            End If
        Next
        resHTM = resHTM & "</tr>"
    Next
    resHTM = resHTM & "</tbody></table>"
    Set rng = Nothing
    ConvertRngToHTM = resHTM
End Function

sBody = Worksheets("Settings").Range("B4").Value

Function ConvertRngToHTM(ParamArray rngs())
    Dim fso As Object, ts As Object
    Dim sF As String, rg As Range, rg2 As Range, v
    sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    With ActiveWorkbook.PublishObjects
        .Delete
        For Each v In rngs
            If IsObject(v) Then
                Set rg2 = v
            Else
                Set rg2 = Range(v)
            End If
            For Each rg In rg2.Areas
                .Add xlSourceRange, sF, rg.Parent.Name, rg.Address, xlHtmlStatic
            Next rg
        Next v
        .Publish
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    ConvertRngToHTM = ts.ReadAll
    ts.Close
    Kill sF
    Set ts = Nothing
    Set fso = Nothing
End Function

Function ConvertRngToHTM(ParamArray rngs())
    Dim fso As Object, ts As Object
    Dim sF As String, rg As Range, rg2 As Range, v
    sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".mht"

    With ActiveWorkbook.PublishObjects
        .Delete

        For Each v In rngs
            Set rg2 = Nothing
            If IsObject(v) Then
                Select Case TypeName(v)
                Case "Range"
                    Set rg2 = v
                Case "ChartObject"
                    Set rg2 = Range(v.TopLeftCell, v.BottomRightCell)
                End Select
            Else
                Set rg2 = Range(v)
            End If
            If Not rg2 Is Nothing Then
                For Each rg In rg2.Areas
                    .Add xlSourceRange, sF, rg.Parent.Name, rg.Address, xlHtmlStatic
                Next rg
            End If
        Next v
        .Publish
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    ConvertRngToHTM = ts.ReadAll
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing
End Function

 ConvertRngToHTM ActiveSheet.ChartObjects(1)

Function ConvertRngToHTM(rng As Range)
    Dim ts As Object
    Dim sF As String, resHTM As String
    Dim wbTmp As Workbook
 
    sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'переносим указанный диапазон в новую книгу
    rng.Copy
    Set wbTmp = Workbooks.Add(1)
    With wbTmp.Sheets(1)
        'вставляем только ширину столбцов, значения и форматы
        .Cells(1).PasteSpecial xlPasteColumnWidths
        .Cells(1).PasteSpecial xlPasteValues
        .Cells(1).PasteSpecial xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        'удаляем все объекты(фигуры, рисунки и пр.)
        '------------------------------------------
        'если рисунки и объекты нужны - удалить этот блок
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
        '------------------------------------------
    End With
    'сохраняем книгу как Веб-страницу(чтобы содержимое конвертировать в HTML-код)
    With wbTmp.PublishObjects.Add( _
         SourceType:=xlSourceRange, Filename:=sF, _
         Sheet:=wbTmp.Sheets(1).Name, Source:=wbTmp.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'открываем созданный файл как текстовый и считываем содержимое
       
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    resHTM = ts.ReadAll
    ts.Close
    'выравниваем таблицу по левому краю(если надо оставить по центру - удалить эту строку)
    ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=")
    'закрываем временную книгу и удаляем
    wbTmp.Close False
    Kill sF
    'очищаем объектные переменные
    Set ts = Nothing: Set fso = Nothing
    Set wbTmp = Nothing
End Function

Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    resHTM = ts.ReadAll
    ts.Close
ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=")
    wbTmp.Close False
    Kill sF
    Set ts = Nothing: Set fso = Nothing
    Set wbTmp = Nothing
    Set rng = Nothing