XL 2016 VBA créer mail outlook

[jl456]

Bonjour,

J'utilise le code suivant pour formater un mail sous Outlook en copiant un tableau d'Excel.
Le code fonctionne bien, mais je souhaiterais ajouter ma signature Mail en bas du mail mais je n'y arrive pas.
Pouvez-vous m'aider svp ? Ci-dessous le code et en PJ le fichier Excel.
Merci,

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''                                                                                                                   ''
''                                                        Envoi MAIL                                                 ''
''                                                                                                                   ''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Mail()


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'       Date et heure pour objet Mail                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DateDuJour = Format(Date, "dd mmmm yyyy")
Heure = Format(Time, "hh:nn")


'''''''''''''''''''''''''''''''''''''
'        Liste de diffusion         '
'''''''''''''''''''''''''''''''''''''
Dim liste_destinataires As String
Dim liste_cc As String

nb_contacts = Worksheets("Tables").Cells(Rows.Count, "B").End(xlUp).Row
nb_contacts_copie = Worksheets("Tables").Cells(Rows.Count, "E").End(xlUp).Row

For I = 2 To nb_contacts
    liste_destinataires = liste_destinataires & Worksheets("Tables").Range("B" & I) & ";"
Next I

For I = 2 To nb_contacts_copie
    liste_cc = liste_cc & Worksheets("Tables").Range("E" & I) & ";"
Next I


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'       Copier le tableau pour ins?rer dans email         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim r As Range
Set r = Range("A3:I13")
r.Copy

      
'''''''''''''''''''''''''''''''''''
'        Pr?paration mail         '
'''''''''''''''''''''''''''''''''''

'ouverture d'Outlook
Dim outlookApp As Object
Set outlookApp = CreateObject("Outlook.Application")

'ouverture d'un nouveau mail
Dim NewMail As Object
Set NewMail = outlookApp.CreateItem(0)
   
'Get its Word editor
NewMail.Display
Dim wordDoc As Object
Set wordDoc = NewMail.GetInspector.WordEditor
       
    With NewMail
        .Display                    'd?clare la signature du mail
        .To = liste_destinataires   '?crit la liste de destinataires
        .cc = liste_cc              '?crit la liste des personnes en copie
        '?crit l'objet du mail
        .Subject = "Mail test | " & DateDuJour & " | " & Heure
        '?crit le corps du mail
        .HTMLBody = "Bonjour," & "<br><br>" & "Vous trouverez ci-dessous les r?sultats" & "<br><br><br>"
        'Ajoute un paragraphe
        wordDoc.Range.InsertParagraphAfter
        'Ajoute le tableau
        wordDoc.Paragraphs(2).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
        'Ajoute un nv paragraphe
        wordDoc.Range.InsertParagraphAfter
        wordDoc.Range.InsertAfter "blabla"
        .Display   '?crit la signature
    End With

End Sub