Macro pour copier coller une image dans un mail

Bonjour

j'ai commencé à faire ma macro. Elle crée un mail avec le destinataire qui figure dans la cellule O1 de l'onglet dates, elle met un corps de mail spécifique en fonction de certains éléments.

En dessous de ce texte, je voudrais que la macro copie les infos des cellules A1 à E5 et colle l'image en dessous du texte puis, en dessous de cette image, figurerait le texte 'Ci-dessous la liste des commerciaux avec des retards supérieurs à 10 k€ : ".

La marco copierait ensuite les cellules H1 à J9 pour les coller sous forme d'image sous le texte précédent.

Mais je n'arrive pas à trouver le code pour copier et coller les omages et completer le mail... pouvez vous m'aider ? merci

Bonsoir,

ci-dessous proposition

Option Explicit

Sub OuvrirMailAvecDestinataireDeCelluleO1()
    Dim OutlookApp As Object, OutlookMail As Object, worddoc As Object, wordrange As Object
    Dim Destinataire As String
    Dim ObjetMail As String
    Dim DateMail As String
    Dim ValeurAgedBalance As Double
    Dim FormatCouleurL21 As String
    Dim FormatCouleurN21 As String
    Dim FormatGrasN21 As String
    Dim message_début As String
    Dim ValeurN21 As Integer, position_début As Integer, lg_signature As Integer

    ' Récupérer l'adresse email de la cellule O1 de l'onglet "Dates"
    Destinataire = Sheets("Dates").Range("O1").Value

    ' Vérifier si une adresse email est présente dans la cellule O1
    If Destinataire = "" Then
        MsgBox "Aucune adresse email trouvée dans la cellule O1.", vbExclamation
        Exit Sub
    End If

    ' Récupérer la date de la cellule A2 de l'onglet "Dates"
    DateMail = Format(Sheets("Dates").Range("A2").Value, "dd/mm/yyyy")

    ' Récupérer la valeur de la cellule L21 de l'onglet "Aged balance"
    ValeurAgedBalance = Sheets("Aged balance").Range("L21").Value

    ' Définir le format de couleur en fonction de la valeur de la cellule L21
    FormatCouleurL21 = IIf(ValeurAgedBalance >= 0, "color: red;", "color: green;")

    ' Récupérer la valeur de la cellule N21 de l'onglet "Aged balance"
    ValeurN21 = Sheets("Aged balance").Range("N21").Value

    ' Définir le format de couleur en fonction de la valeur de la cellule N21
    If ValeurN21 >= 0 Then
        FormatCouleurN21 = "color: red;"
        FormatGrasN21 = "font-weight: bold;"
    Else
        FormatCouleurN21 = "color: green;"
        FormatGrasN21 = "font-weight: bold;"
    End If

    ' Définir le message de début
    message_début = "<p style='font-family: Calibri; font-size: 11pt; color: black;'>Bonjour à tous,<br><br>" & _
              "Vous pouvez cliquer ici pour accéder à la balance âgée.<br><br>" & _
              "La France a un retard de <span style='font-weight: bold; " & FormatCouleurL21 & "'>" & Format(ValeurAgedBalance, "0.00%") & "</span> (" & _
              "<span style='" & FormatGrasN21 & " " & FormatCouleurN21 & "'>" & Format(ValeurN21, "0.00%") & " hors paiements d’avance & crédits)</span> splitté de la manière suivante :</p>"

    ' Créer une instance d'Outlook
    Set OutlookApp = CreateObject("Outlook.Application")
    ' Vérifier la présence d'un explorateur Outlook
    If OutlookApp.Explorers.Count = 0 Then
        OutlookApp.Session.GetDefaultFolder(olFolderInbox).Display
        OutlookApp.ActiveExplorer.WindowState = olMinimized
    End If
    ' Créer un nouveau mail
    Set OutlookMail = OutlookApp.CreateItem(0)

    ' Remplissage du mail
    With OutlookMail
        Set worddoc = .GetInspector.WordEditor

        'Sujet, destinataire, signature, début message
        .Subject = "Point crédit clients FRANCE au " & DateMail
        .To = Destinataire
        .Display    'insertion signature
        lg_signature = Len(worddoc.Content.Text)

        .HTMLBody = message_début & .HTMLBody
        position_début = Len(worddoc.Content.Text) - lg_signature

        'suite du message
        Set wordrange = worddoc.Range(position_début, position_début)
        With wordrange

            ' Insérer le tableau1 dans le corps du mail
            Sheets("Synthesis").Range("A1:E5").Copy
            .Paste
            .Move 4, 2

            .Text = "Ci-dessous la liste des commerciaux avec des retards supérieurs à 10 k€ : "
            .Move 4, 1

            ' Insérer le tableau2 dans le corps du mail
            Sheets("Synthesis").Range("H1:J9").Copy
            .Paste
            .Move 4, 1
            .InsertAfter vbNewLine

        End With

        .Display ' Afficher le brouillon du mail pour permettre à l'utilisateur de le vérifier avant envoi

    End With

    ' Nettoyer les objets Outlook
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub