Sub ТО_ПК_Кнопка()

   Dim objOutlookApp As Object, objMail As Object

   Application.ScreenUpdating = False

   On Error Resume Next

   Set objOutlookApp = CreateObject("Outlook.Application")

   objOutlookApp.Session.Logon

   Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение

   If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub

   On Error GoTo 0

   'создаем сообщение

   With objMail

       .To = Range("B7").Value

       .Subject = "Добрый день!...."

       .BodyFormat = 2  'olFormatHTML - формат HTML

       .HTMLBody = ConvertRngToHTM(Range("A2:M6"))

       .Display 'отображаем сообщение

       .ReadReceiptRequested = True

       objMail.Importance = 2 'olImportanceHigh

   End With

   Set objOutlookApp = Nothing: Set objMail = Nothing

   Application.ScreenUpdating = True

End Sub

Function ConvertRngToHTM(rng As Range)

   Dim fso As Object, 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