[XL-2007] Rajouter une image en haut d'un mail codé en VBA

Bonjour,

Je viens vers vous, car j'ai un petit soucis (je suis débutant en vba).
Je ne sais pas comment faire pour rajouter une image en haut de mon mail en code vba. Je souhaiterai que le logo apparaissent en haut de page du mail à envoyer.

Voici le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
sub Mail_Client_08a_MES_Ok()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
 
 
 
    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
   'Exemple pour envoyer un classeur en pièce jointe
   'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
   'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
   'Ou bien entrer le path et nom du fichier autrement
   Nom_Fichier = "C:\Chemin\NomFichier.ext"
   SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Default.htm"
 
    If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
     With oBjMail
            .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
 
        .To = Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "A")) ' le destinataire
        .CC = Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Cc")) ' le destinataire
 
        If b_Cci = True Then
            .BCC = st_Cci
        End If
 
        st_Subj = "[COMPLETEL] [" & Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Nom client facture")) & " " & Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Code client facture")) & "] - " & Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Cls")) & " / " & Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "N° Bc")) & " / " & Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Nom site")) & " / " & Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Ville")) & " - Mise en service réalisée"
       .Subject = st_Subj          ' l'objet du mail
       .HTMLBody = "<span style=""font-size: 12px;font-family: Arial"">Bonjour,<br><br>" & _
       "Nous vous informons que l'installation du service " & _
       Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Designation du bc")) & _
       " sur le site " & Cells(Selection.Row, Mapping_Col(Sheets("Data").Range("A1:FF1"), "Cls")) & " est terminée et validée.<br><br>" & _
       "Les tests réalisés par nos techniciens ont été concluants, vous recevrez bientôt le PV de recette.<br><br>" & _
       "Restant à votre disposition si besoin.</span>" & .HTMLBody
       '.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
 
    End With
 
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End Sub

Merci d'avance