Changement de police, d'écriture et supression d'espace

Bonjour,

Pourriez-vous, s'il vous plaît, me dire s'il est possible d'ajouter un code à la macro ci-dessous afin que le texte extrait de la colonne "Body = Replace(sh.Range("C" & i), Chr(10), "<br>")" de mon fichier Excel soit affiché en police 12 et en style courrier lors de l'envoi de mon mail ? Aussi je souhaiterais que l'espace en tre la formule de politesse et la signature soit moins importante.

Sub Envoi_mails()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Envoi mails")
Dim i As Integer

Dim OA As Object
Dim msg As Object

Set OA = CreateObject("outlook.application")

Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))

For i = 2 To last_row
If sh.Range("I" & i).Value <> "NON" Then
Set msg = OA.CreateItem(0)

' Afficher le mail pour récupérer la signature
msg.display
msg.To = sh.Range("A" & i).Value
msg.Subject = sh.Range("B" & i).Value

' Remplacer les sauts à la ligne forcés par des codes HTML

Dim sBody As String
sBody = Replace(sh.Range("C" & i), Chr(10), "<br>")
' Ajouter la signature au message
msg.HTMLbody = sBody & msg.HTMLbody

If sh.Range("F" & i).Value <> "" Then
msg.Attachments.Add sh.Range("F" & i).Value
End If

msg.display
'msg.Send

sh.Range("J" & i).Value = "Envoyé"
End If

Next i

MsgBox "Messages Envoyés"

End Sub

Je vous remercie d'avance pour votre aide.

Si vous le souhaitez, je peux vous envoyer le ficher.

Cordialement,

Prya

Hello,

Un essai

Sub Envoi_mails()

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Envoi mails")

    Dim i As Long
    Dim last_row As Long

    Dim OA As Object
    Dim msg As Object

    Set OA = CreateObject("Outlook.Application")

    last_row = Application.CountA(sh.Range("A:A"))

    For i = 2 To last_row

        If sh.Range("I" & i).Value <> "NON" Then

            Set msg = OA.CreateItem(0)

            ' Afficher le mail pour charger la signature
            msg.Display

            msg.To = sh.Range("A" & i).Value
            msg.Subject = sh.Range("B" & i).Value

            Dim sBody As String
            Dim sHTML As String

            ' Remplacer les retours ligne Excel par <br>
            sBody = Replace(sh.Range("C" & i).Value, Chr(10), "<br>")

            ' Supprimer les <br> en fin de texte
            Do While Right(sBody, 4) = "<br>"
                sBody = Left(sBody, Len(sBody) - 4)
            Loop

            ' Mise en forme HTML : Courier 12 + espace réduit avant signature
            sHTML = "<div style='font-family:Courier New; font-size:12pt; margin-bottom:4px;'>" _
                    & sBody & _
                    "</div>"

            ' Insérer le texte avant la signature Outlook
            msg.HTMLBody = sHTML & msg.HTMLBody

            ' Pièce jointe si présente
            If sh.Range("F" & i).Value <> "" Then
                msg.Attachments.Add sh.Range("F" & i).Value
            End If

            msg.Display
            ' msg.Send   ' ← décommente quand tout est OK

            sh.Range("J" & i).Value = "Envoyé"

        End If

    Next i

    MsgBox "Messages envoyés", vbInformation

End Sub

@+

Merci beaucoup Baroute78 !

Pourriez-vous, SVP, m'expliquer ce que signifie

margin-bottom:4px

Je vous remercie pour votre retour et votre aide précieuse.

Cordialement,

Prya

Hey,

On essaie de remplacer les pt par px sur la taille de la police.

Sub Envoi_mails()

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Envoi mails")

    Dim i As Long
    Dim last_row As Long

    Dim OA As Object
    Dim msg As Object

    Set OA = CreateObject("Outlook.Application")

    last_row = Application.CountA(sh.Range("A:A"))

    For i = 2 To last_row

        If sh.Range("I" & i).Value <> "NON" Then

            Set msg = OA.CreateItem(0)

            ' Afficher le mail pour charger la signature Outlook
            msg.Display

            msg.To = sh.Range("A" & i).Value
            msg.Subject = sh.Range("B" & i).Value

            Dim sBody As String
            Dim sHTML As String

            ' Retours ligne Excel → <br>
            sBody = Replace(sh.Range("C" & i).Value, Chr(10), "<br>")

            ' Nettoyage final des <br>
            Do While Right(sBody, 4) = "<br>"
                sBody = Left(sBody, Len(sBody) - 4)
            Loop

            ' TEXTE PRINCIPAL — AUCUN ESPACE AJOUTÉ
            sHTML = "<p style='font-family:Courier New; font-size:16px; margin:0; padding:0; line-height:normal;'>" _
                    & sBody & _
                    "</p>"

            ' Injection AVANT la signature
            msg.HTMLBody = sHTML & msg.HTMLBody

            ' Pièce jointe
            If sh.Range("F" & i).Value <> "" Then
                msg.Attachments.Add sh.Range("F" & i).Value
            End If

            msg.Display
            ' msg.Send   ' ← Activer pour envoi direct

            sh.Range("J" & i).Value = "Envoyé"

        End If

    Next i

    MsgBox "Messages envoyés", vbInformation

End Sub

Le 4px signifie qu'on ajoute un espace de 4 pixel sous l'élément

@+

Merci infiniment Baroute78 !

Hello,

Néanmoins, je n'ai pas réussi à reproduire cette action pour l'objet du mail : msg.Subject = sh.Range("D" & i).Value. J'aurais voulu spécifier Times New Roman et une taille de police de 12.

la modification de police n'est possible que sur le contenu du mail, pas sur le sujet

Hey,

Merci pour le retour

@+