Microsoft 365 Vba mail outlook texte en gras

raf26

XLDnaute Occasionnel
Bonjour le forum,

J'ai besoin de votre aide.

Malgré mes recherches, je suis perdu entre tout ce que j'ai trouvé. (les <b> span style etc....)

Je n'arrive pas à mettre des parties de mon mail en gras et à adapter les résultats des posts.

L'envoi mail marche, je veux juste que le sujet et le corps du mail soit en gras (et si possible taille 14).

Ci-dessous mon code

Merci d'avance pour votre aide.

Bon week-end
VB:
Sub Mail()        'envoi mail
    
    Dim OutObj      As Object, OutMail As Object
    Dim sPath       As String, sNomFic As String
    Dim sAdrmail    As String, strSujet As String, strBody As String
    
    Set OutObj = CreateObject("outlook.application")        'lance outlook
    Set OutMail = OutObj.CreateItem(0)
    
    Sheets("blabla").Visible = TRUE
    sAdrmail = Sheets("blabla").Range("A58")        'adresse destinataire
    SAdrCC = Sheets("balbla").Range("A59")        'adresse CC
    
    strSujet = "engras" & Sheets("balbla").Range("D42") & " " & Sheets("blabla").Range("D41")        'sujet du mail
    
    'corps du mail
    With Sheets("blabla")
        
        strBody = "-----EN GRAS - ------ <br> <br>je veux ce texte en gras" & Sheets("balbla").Range("D42") & "  " & Sheets("balbla").Range("D41") & " je veux ce texte en gras " & " : <br><br>"
        
        strBody = strBody & Extraire(.Range("A53")) & ""        'LIGNE COMPLETE DOIT ETRE EN GRAS
        
    End With
    
    With OutMail
        .Display        'affiche le mail sans l'envoyer sinon .send
        
        .To = sAdrmail
        .CC = SAdrCC
        .Subject = strSujet
        .HTMLBody = strBody & "<br><br>" & .HTMLBody
        
    End With
    
    Set OutMail = Nothing
    Set OutObj = Nothing
    Sheets("blabla").Select
    ActiveWindow.SelectedSheets.Visible = FALSE
    
    Sheets("balbla2").Activate
    
End Sub
 

patricktoulon

XLDnaute Barbatruc
re
tiens j'ai corrigé une petite erreur de ma part testé avec outlook
VB:
Sub Mail()        'envoi mail
    
    Dim OutObj      As Object, OutMail As Object
    Dim sPath       As String, sNomFic As String
    Dim sAdrmail    As String, strSujet As String, strBody As String
    
    Set OutObj = CreateObject("outlook.application")        'lance outlook
    Set OutMail = OutObj.CreateItem(0)
    
     sAdrmail = "Raf26@toto.com"        'adresse destinataire
    SAdrCC = "moimeme@hotmail.com'        'adresse CC"
       strSujet = "juste un coucou"        'sujet du mail
           strBody = "<p>"
    strBody = strBody & arrangetext("Bonjour ", , , , True, True, True)
    strBody = strBody & arrangetext("Raf26 ", "blue", 28, , True, , True) & "<br/>"
    strBody = strBody & arrangetext("comment va tu aujourd'hui", "red", , "Arial") & "<br/>"
    strBody = strBody & "tu t'éclate bien sur "
    strBody = strBody & arrangetext("EXCELDOWNLOAD", "green", 30, "Algerian", True)
    strBody = strBody & "</p>"
     With OutMail
        .Display        'affiche le mail sans l'envoyer sinon .send
        
        .To = sAdrmail
        .CC = SAdrCC
        .Subject = strSujet
        .HTMLBody = strBody
        
    End With
    
    Set OutMail = Nothing
    Set OutObj = Nothing
    
End Sub
Function arrangetext(txt, Optional couleur As Variant = "", Optional fontsiz As Long = 0, Optional fontName As String = "calibri", Optional bolder As Boolean = False, Optional italique As Boolean = False, Optional underligne As Boolean = False, Optional barré As Boolean = False)
    Dim Fc As Object
    With CreateObject("htmlfile")
        Set Fc = .createelement("FONT")
        If couleur <> "" Then Fc.Color = couleur
        If fontsiz > 0 Then Fc.Style.fontsize = fontsiz & "px"
        If barré Then txt = "<strike>" & txt & "</strike"
        If underligne Then txt = "<u>" & txt & "</u>"
        If italique Then txt = "<em>" & txt & "</em>"
        If bolder Then txt = "<strong>" & txt & "</strong>"
        Fc.innerhtml = txt
        If Not IsNull(Fc.getattribute("size")) Then Fc.removeAttribute ("size")
        arrangetext = Fc.outerhtml
    End With
End Function

Capture.JPG
 

patricktoulon

XLDnaute Barbatruc
re j'en ai profité pour te lettre le fontname aussi je ne l'avais pas fait dans la fonction
maintenant tu peux injecter la couleur sous toutes ses formes possibles
en texte: "red",yellow","blue" ,"orange"etc...
en constante vb : vbred,vbgreen,vbmagenta,etc......
par les index de couleurs excel 1,2,3,4,5,.....56
par le rgb: rgb(x,y,z)
VB:
Sub Mail()        'envoi mail

    Dim OutObj As Object, OutMail As Object
    Dim sPath As String, sNomFic As String
    Dim sAdrmail As String, strSujet As String, strBody As String

    Set OutObj = CreateObject("outlook.application")        'lance outlook
    Set OutMail = OutObj.CreateItem(0)

    sAdrmail = "Raf26@toto.com"        'adresse destinataire
    SAdrCC = "moimeme@hotmail.com'        'adresse CC"
    strSujet = "juste un coucou"        'sujet du mail
    strBody = "<p>"
    strBody = strBody & arrangetext("Bonjour ", RGB(255, 0, 255), 15, , True, True, True)
    strBody = strBody & arrangetext("Raf26 ", "3", 28, , True, , True) & "<br/>"
    strBody = strBody & arrangetext("comment va tu aujourd'hui", "orange", , "Arial") & "<br/>"
    strBody = strBody & "tu t'éclate bien sur "
    strBody = strBody & arrangetext("EXCELDOWNLOAD", "green", 30, "Algerian", True)
    strBody = strBody & "</p>"
    With OutMail
        .Display        'affiche le mail sans l'envoyer sinon .send
        .To = sAdrmail
        .CC = SAdrCC
        .Subject = strSujet
        .HTMLBody = strBody
    End With
    Set OutMail = Nothing
    Set OutObj = Nothing

End Sub
Function arrangetext(txt, Optional couleur As Variant = "", Optional fontsiz As Long = 0, Optional fontName As String = "calibri", Optional bolder As Boolean = False, Optional italique As Boolean = False, Optional underligne As Boolean = False, Optional barré As Boolean = False)
    Dim Fc As Object
    With CreateObject("htmlfile")
        Set Fc = .createelement("FONT")
        If IsNumeric(couleur) Then
            If couleur <= 56 Then couleur = HtmlColor(ThisWorkbook.Colors(couleur)) Else couleur = HtmlColor(couleur)
        End If
         If couleur <> "" Then Fc.Color = couleur
        If fontsiz > 0 Then Fc.Style.FontSize = fontsiz & "px"
        If fontName <> "calibri" Then Fc.face = fontName
        If barré Then txt = "<strike>" & txt & "</strike>"
        If underligne Then txt = "<u>" & txt & "</u>"
        If italique Then txt = "<em>" & txt & "</em>"
        If bolder Then txt = "<strong>" & txt & "</strong>"
        Fc.innerhtml = txt
        If Not IsNull(Fc.getattribute("size")) Then Fc.removeAttribute ("size")
        arrangetext = Fc.outerhtml
    End With
End Function
Function HtmlColor(x) As String
    c = Right("000000" & Hex(x), 6)
    HtmlColor = "#" & Mid(c, 5, 2) & Mid(c, 3, 2) & Mid(c, 1, 2)
End Function
demonstartion
Capture.JPG
 
Dernière édition:

Discussions similaires

Réponses
6
Affichages
268
Réponses
17
Affichages
1 K
Réponses
2
Affichages
98