XL 2016 VBA copier cellules en image sous Outlook

Sub Mail()

Dim tab_synthèse As Range
Dim liste_destinataires1 As String
Dim liste_cc1 As String
Dim OutlookApp1 As Object
Dim NewMail1 As Object
Dim tab1 As Object
Dim wDoc As Object
  



ActiveWorkbook.Save

DateDuJour = Format(Date, "dd mmmm yyyy")
Heure = Format(Time, "hh:nn")

'''''''''''''''''''''''''''''''''''''
'        Liste de diffusion         '
'''''''''''''''''''''''''''''''''''''

nb_contacts1 = Worksheets("Notice").Cells(Rows.Count, "Q").End(xlUp).Row
nb_contacts_copie1 = Worksheets("Notice").Cells(Rows.Count, "T").End(xlUp).Row

For i = 2 To nb_contacts1
    liste_destinataires1 = liste_destinataires1 & Worksheets("Notice").Range("Q" & i) & ";"
Next i

For i = 2 To nb_contacts_copie1
    liste_cc1 = liste_cc1 & Worksheets("Notice").Range("T" & i) & ";"
Next i


        
'''''''''''''''''''''''''''''''''''
'        Préparation mail         '
'''''''''''''''''''''''''''''''''''

Set OutlookApp1 = CreateObject("Outlook.Application")                                               'ouverture d'Outlook
Set NewMail1 = OutlookApp1.CreateItem(0)                                                            'ouverture d'un nouveau mail



    With NewMail1
        .Display                                                                                    'déclare la signature du mail
        .To = liste_destinataires1                                                                  'écrit la liste de destinataires
        .CC = liste_cc1                                                                             'écrit la liste des personnes en copie
        .Subject = "Mail | " & DateDuJour & " | " & Heure                          'écrit l'objet du mail
   
       
   
    Set wDoc = NewMail1.GetInspector.WordEditor
    ActiveSheet.Range("R5", ActiveSheet.Range("a65536").End(xlUp)).CopyPicture
    wDoc.Application.Selection.Paste
   
        Set rng = wDoc.Content
        rng.InsertBefore "Bonjour" & vbNewLine & vbNewLine & "Voici le résultat :" & vbNewLine
        rng.InsertAfter vbNewLine & vbNewLine & "Merci" & vbNewLine
   
     .Display
                   
                                                                                         
    End With


End Sub