Copy Excel range as picture to Outlook mail under text in body

Question

I would like to copy a range from protected Excel sheet and paste it into Outlook as a picture.

My code is pasting the text then the picture, but at the same time deleting the text.

How can I paste the picture under the text.

Sub Send_Email()
   
   Dim r As Range
   Set r = Range("NR7:OD39")
   
   Dim outlookApp As Outlook.Application
   Set outlookApp = CreateObject("Outlook.Application")
   
   Dim OutMail As Outlook.MailItem
   Set OutMail = outlookApp.CreateItem(olMailItem)
    
   Dim StrFileName As String
    
   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
  
   Sheets("table1").Select
   ActiveSheet.Unprotect Password:="blabla"

   ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8

   r.Select
   r.Copy
    
   OutMail.Display
   
   Dim Email As Word.Document
   Set Email = OutMail.GetInspector.WordEditor
    
   With OutMail

      .To = "[email protected]"
      .CC = "[email protected]"
      .Subject = "Subject"
      .Body = "Hi everybody," & vbNewLine & "actual Status"
      .Display
      
   End With
      
   Email.Range.PasteAndFormat wdChartPicture
   
   ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
   ActiveSheet.Protect Password:="blabla"

End Sub

Answer 1

Starting with this line

Set Email = OutMail.GetInspector.WordEditor

this should do it:

Dim ran as Word.Range
    Set Email = OutMail.GetInspector.WordEditor

       With OutMail

          .To = "[email protected]"
          .cc = "[email protected]"
          .Subject = "Subject"
          .Body = "Hi everybody," & vbNewLine & "actual Status"
          .Display

       End With
    Email.Range.InsertAfter vbCrLf
    Set ran = Email.Range(Email.Content.End - 1, Email.Content.End - 1)
    ran.PasteAndFormat wdChartPicture