Sub Mail_Selection_Range_Outlook_Body()
       Dim rng As Range
       Dim OutApp As Object
       Dim OutMail As Object
          
       Set rng = Nothing
       On Error Resume Next
       Set rng = Sheets(1).Range("A1:K4").SpecialCells(xlCellTypeVisible)
       On Error GoTo 0

       If rng Is Nothing Then
           MsgBox "The selection is not a range or the sheet is protected. " & _
                  vbNewLine & "Please correct and try again.", vbOKOnly
           Exit Sub
       End If

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

       Set OutApp = CreateObject("Outlook.Application")
       Set OutMail = OutApp.CreateItem(0)
          
       strbodyb = "ТЕКСТ 1"
                        
       Strbodya = "ТЕКСТ 2"
                    
       On Error Resume Next
       With OutMail
           .To = "test@test.ru"
           .CC = ""
           .BCC = ""
           .Subject = "Название письма"
           .HTMLBody = strbodyb & RangetoHTML(rng) & Strbodya    
           .Display

       End With
       On Error GoTo 0

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

       Set OutMail = Nothing
       Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
       Dim fso As Object
       Dim ts As Object
       Dim TempFile As String
       Dim TempWB As Workbook

       TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
       
       ' Copy the range and create a workbook to receive the data.
       rng.Copy
       Set TempWB = Workbooks.Add(1)
       With TempWB.Sheets(1)
           .Cells(1).PasteSpecial Paste:=8
           .Cells(1).PasteSpecial xlPasteValues, , False, False
           .Cells(1).PasteSpecial xlPasteFormats, , False, False
           .Cells(1).Select
           Application.CutCopyMode = False
           On Error Resume Next
           .DrawingObjects.Visible = True
           .DrawingObjects.Delete
           On Error GoTo 0
       End With
       
       ' Publish the sheet to an .htm file.
       With TempWB.PublishObjects.Add( _
            SourceType:=xlSourceRange, _
            Filename:=TempFile, _
            Sheet:=TempWB.Sheets(1).Name, _
            Source:=TempWB.Sheets(1).UsedRange.Address, _
            HtmlType:=xlHtmlStatic)
           .Publish (True)
       End With
       
       ' Read all data from the .htm file into the RangetoHTML subroutine.
       Set fso = CreateObject("Scripting.FileSystemObject")
       Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
       RangetoHTML = ts.ReadAll
       ts.Close
       RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                             "align=left x:publishsource=")
       
       ' Close TempWB.
       TempWB.Close savechanges:=False
       
       ' Delete the htm file.
       Kill TempFile
       
       Set ts = Nothing
       Set fso = Nothing
       Set TempWB = Nothing
End Function