XL 2019 Mail en HTML vs VBA

gilles37

gilles37

XLDnaute Occasionnel
Bonjour à tous,

J'ai un envoi mail en vba mais je souhaiterai qu'il soit en html afin d'améliorer la lecture.
Je n'y arrive pas.😕
Ci-dessous le code vba.( html sera compatible avec le reste des macros en VBA?)


VB: 
Private Sub CommandButton3_Click()

Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xOutMsg As String
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
   
   
   
   
   '=============================================================
  
    'Création de l'objet Outlook
    Set ApplicOutlook = CreateObject("Outlook.Application")



    'Extraction des données
       
   '====================================
    Sujet = "rapport N°" & TextBox1.Value & " " & "Equipement" & " " & ComboBox11.Value & " " & ">>> Message automatique <<<"
   '====================================
       
    'Composition du message
   
   '===================================
    msg = "le " & "  " & TextBox16.Value & "  " & TextBox17.Value & "  " & TextBox18.Value & vbLf & vbLf   '[COLOR=rgb(65, 168, 95)]( avoir le "le" en gras souligné)[/COLOR]
   '===================================
       
    msg = msg & "Equipement : " & ComboBox11.Value & vbLf &  ' [COLOR=rgb(97, 189, 109)]( avoir  "Equipement " en gras souligné)[/COLOR]
   
   
    msg = msg & "commentaire / Analyse:    " & TextBox5.Value & vbLf & vbLf '[COLOR=rgb(65, 168, 95)]( avoir  "commentaire / Analyse " en gras souligné)[/COLOR]
   
    msg = msg & "Actions curatives:    " & TextBox6.Value & vbLf & ' [COLOR=rgb(65, 168, 95)]( avoir  "Actions curatives: " en gras souligné)[/COLOR]
   
   
    msg = msg & "Fiche établie par:   " & ComboBox8.Value & vbLf & vbLf [COLOR=rgb(65, 168, 95)]' ( avoir  "Fiche établie par: " en gras souligné)[/COLOR]
   
   
    msg = msg & "" & vbLf & vbLf
    msg = msg & "===================== Ne pas répondre, message automatique ==================================="
       
    'Création de l'élément de courrier et envoi
   ' Set ElémentCourrier = ApplicOutlook.CreateItem(0)
   
    '======================================================

 With xOutMail
 
     
           '.To = Range("Adres2").Value
          '.CC = Range("Adres1").Value
            .BCC = Range("Adres3").Value
            .Subject = Sujet
            .HTMLBody = msg
        .Display
 .Send
 ActiveWorkbook.SaveAs Filename:="X:\suivi des rapports équipements.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    CommandButton1 = True

 
 
   
  .HTMLBody = xOutMsg
        .Display
    End With
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Merci a vous et bonnes fêtes de fin d'année
 
Dernière modification par un modérateur:
Solution
Bernard_XLD
re,

intégrez un retour chariot à la place des vblf, juste cette balise <br/>
j'ai ajouté les mises en couleur, pas testé car pas de fichier de test fourni mais cela devrait fonctionner
J'ai aussi mis le message en police Arial taille 11.5, plus lisible à mon sens que la Calibri 10 par défaut.

Cordialement, @+
VB: 
Private Sub CommandButton3_Click()

Dim xOutApp As Object
Dim xOutMail As Object
Dim xOutMsg As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'=============================================================
'Création de l'objet Outlook
Set ApplicOutlook = CreateObject("Outlook.Application")
'Extraction des données
'====================================
Sujet =...
Trier par date Trier par votes
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
re,

essayez comme cela, pas testé.
et, s'il vous plait, mettez vos codes dans les balises de code à l'aide du bouton </>, c'est beaucoup plus agréable pour ceux qui vous lisent

Cordialement, @+
VB: 
Private Sub CommandButton3_Click()

Dim xOutApp As Object
Dim xOutMail As Object
Dim xOutMsg As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'=============================================================
'Création de l'objet Outlook
Set ApplicOutlook = CreateObject("Outlook.Application")
'Extraction des données
'====================================
Sujet = "rapport N°" & TextBox1.Value & " " & "Equipement" & " " & ComboBox11.Value & " " & ">>> Message automatique <<<"
'====================================
'Composition du message
'===================================
msg = "<u><b>le </b></u>" & " " & TextBox16.Value & " " & TextBox17.Value & " " & TextBox18.Value & vbLf & vbLf '( avoir le "le" en gras souligné)
'===================================
msg = msg & "<u><b>Equipement : </b></u>" & ComboBox11.Value & vbLf  ' ( avoir "Equipement " en gras souligné)
msg = msg & "<u><b>commentaire / Analyse: </b></u>" & TextBox5.Value & vbLf & vbLf '( avoir "commentaire / Analyse " en gras souligné)
msg = msg & "<u><b>Actions curatives: </b></u>" & TextBox6.Value & vbLf  ' ( avoir "Actions curatives: " en gras souligné)
msg = msg & "<u><b>Fiche établie par: </b></u>" & ComboBox8.Value & vbLf & vbLf ' ( avoir "Fiche établie par: " en gras souligné)
msg = msg & "" & vbLf & vbLf
msg = msg & "===================== Ne pas répondre, message automatique ==================================="

'Création de l'élément de courrier et envoi
' Set ElémentCourrier = ApplicOutlook.CreateItem(0)

'======================================================

With xOutMail

'.To = Range("Adres2").Value
'.CC = Range("Adres1").Value
.BCC = Range("Adres3").Value
.Subject = Sujet
.HTMLBody = msg
.Display
.Send
ActiveWorkbook.SaveAs Filename:="X:\suivi des rapports équipements.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
CommandButton1 = True

.HTMLBody = xOutMsg
.Display
End With
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
 
Vote positif 0 Vote négatif
gilles37

gilles37

XLDnaute Occasionnel
Bonjour Bernard_XLD, le forum

Le résultat est au rendez vous sauf qu'il n'y a pas de sauf a la ligne

VB: 
msg = msg & "<u><b>Equipement : </b></u>" & ComboBox11.Value & vbLf  ' [COLOR=rgb(41, 105, 176)]( souhaite retour a la ligne)[/COLOR]
msg = msg & "<u><b>commentaire / Analyse: </b></u>" & TextBox5.Value & vbLf & vbLf[COLOR=rgb(41, 105, 176)] '( souhaite retour a la ligne)[/COLOR]
msg = msg & "<u><b>Actions curatives: </b></u>" & TextBox6.Value & vbLf [COLOR=rgb(41, 105, 176)] ' ( souhaite retour a la ligne)[/COLOR]
msg = msg & "<u><b>Fiche établie par: </b></u>" & ComboBox8.Value & vbLf & vbLf [COLOR=rgb(41, 105, 176)]' ( souhaite retour a la ligne)[/COLOR]
msg = msg & "" & vbLf & vbLf
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
re,

intégrez un retour chariot à la place des vblf, juste cette balise <br/>
j'ai ajouté les mises en couleur, pas testé car pas de fichier de test fourni mais cela devrait fonctionner
J'ai aussi mis le message en police Arial taille 11.5, plus lisible à mon sens que la Calibri 10 par défaut.

Cordialement, @+
VB: 
Private Sub CommandButton3_Click()

Dim xOutApp As Object
Dim xOutMail As Object
Dim xOutMsg As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'=============================================================
'Création de l'objet Outlook
Set ApplicOutlook = CreateObject("Outlook.Application")
'Extraction des données
'====================================
Sujet = "rapport N°" & TextBox1.Value & " Équipement" & " " & ComboBox11.Value & " " & ">>> Message automatique <<<"
'====================================
'Composition du message
'===================================
Msg = "<u><b><font style=""color:#41A85F"" >le</font></b></u>" & " " & TextBox16.Value & " " & TextBox17.Value & " " & TextBox18.Value & "<br/><br/>"
'===================================
Msg = Msg & "<u><b><font style=""color:#61BD6D"" >Équipement:</font></b></u>" & " " & ComboBox11.Value & "<br/>"
Msg = Msg & "<u><b><font style=""color:#41A85F"" >Commentaire / Analyse:</font></b></u>" & " " & TextBox5.Value & "<br/><br/>"
Msg = Msg & "<u><b><font style=""color:#41A85F"" >Actions curatives:</font></b></u>" & " " & TextBox6.Value & "<br/>"
Msg = Msg & "<u><b><font style=""color:#41A85F"" >Fiche établie par:</font></b></u>" & " " & ComboBox8.Value & "<br/><br/>"
Msg = Msg & "" & "<br/><br/>"
Msg = Msg & "===================== Ne pas répondre, message automatique ==================================="
Msg = "<font style=""font-family:Arial;font-size:11.5pt"">" & Msg & "</font>"

'Création de l'élément de courrier et envoi
' Set ElémentCourrier = ApplicOutlook.CreateItem(0)

'======================================================

With xOutMail

'.To = Range("Adres2").Value
'.CC = Range("Adres1").Value
.BCC = Range("Adres3").Value
.Subject = Sujet
.HTMLBody = Msg
.Display
.Send
ActiveWorkbook.SaveAs Filename:="X:\suivi des rapports équipements.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
CommandButton1 = True

.HTMLBody = xOutMsg
.Display
End With
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
1° les balises <FONT> ont leur propre attribut "color" donc pas besoins de passer par le (Style CSS)

2° afin de ne pas t'ennuyerla prochaine fois a chercher le code couleurhtml par rapport a une couleur excel (long/vb/rgb/etc..), je vous propose ma fonction de conversion

VB: 
Private Sub CommandButton3_Click()

Dim xOutApp As Object
Dim xOutMail As Object
Dim xOutMsg As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'=============================================================
'Création de l'objet Outlook
Set ApplicOutlook = CreateObject("Outlook.Application")
'Extraction des données
'====================================
Sujet = "rapport N°" & TextBox1.Value & " Équipement" & " " & ComboBox11.Value & " " & ">>> Message automatique <<<"
'====================================
'Composition du message
'===================================
Msg = "<u><b><font color=" & coul_XL_to_coul_HTMLX(RGB(65, 168, 95)) & " >le</font></b></u>" & " " & TextBox16.Value & " " & TextBox17.Value & " " & TextBox18.Value & "<br/><br/>"
'===================================
Msg = Msg & "<u><b><font color=" & coul_XL_to_coul_HTMLX(RGB(97, 189, 109)) & " >Équipement:</font></b></u>" & " " & ComboBox11.Value & "<br/>"
Msg = Msg & "<u><b><font color=" & coul_XL_to_coul_HTMLX(RGB(65, 168, 95)) & "  >Commentaire / Analyse:</font></b></u>" & " " & TextBox5.Value & "<br/><br/>"
Msg = Msg & "<u><b><font color=" & coul_XL_to_coul_HTMLX(RGB(65, 168, 95)) & "  >Actions curatives:</font></b></u>" & " " & TextBox6.Value & "<br/>"
Msg = Msg & "<u><b><font color=" & coul_XL_to_coul_HTMLX(RGB(65, 168, 95)) & "  >Fiche établie par:</font></b></u>" & " " & ComboBox8.Value & "<br/><br/>"
Msg = Msg & "" & "<br/><br/>"
Msg = Msg & "===================== Ne pas répondre, message automatique ==================================="
Msg = "<font style=""font-family:Arial;font-size:11.5pt"">" & Msg & "</font>"

'Création de l'élément de courrier et envoi
' Set ElémentCourrier = ApplicOutlook.CreateItem(0)

'======================================================

With xOutMail

'.To = Range("Adres2").Value
'.CC = Range("Adres1").Value
.BCC = Range("Adres3").Value
.Subject = Sujet
.HTMLBody = Msg
.Display
.Send
ActiveWorkbook.SaveAs Filename:="X:\suivi des rapports équipements.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
CommandButton1 = True

.HTMLBody = xOutMsg
.Display
End With
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Function coul_XL_to_coul_HTMLX(couleur)
'fonction HTMLCOLOR ---> By Patricktoulon
    Dim str0 As String, strf As String
    str0 = Right("000000" & Hex(couleur), 6): strf = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
    coul_XL_to_coul_HTMLX = "#" & strf & ""
End Function
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
371
Minus&Cortex
M
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
205
spike29
S
G
  • Résolu(e)
XL 2021 Envoie d'informations sélectionnés par mail
Réponses
3
Affichages
202
TooFatBoy
TooFatBoy
My<3
  • Question
XL 2019 HTML Corps de mail
Réponses
6
Affichages
612
My<3
My<3
M
  • Résolu(e)
XL 2016 envoi de mail en automatique en fonction de plusieurs menus deroulants
2
Réponses
26
Affichages
2 K
mathieu20
M
V
  • Question
Microsoft 365 Générer un mail Outlook via Excel si modification colonne Excel
Réponses
1
Affichages
1 K
gig83500
G
J
  • Résolu(e)
XL 2013 Macro et script vba : macro s'arrête dès la première condition trouvée
Réponses
11
Affichages
822
Janu44
J
D
  • Question
Microsoft 365 Envoi mail Outlook depuis Excel : changement de taille de police si signature insérée
Réponses
6
Affichages
2 K
Deadpool_CC
Deadpool_CC
B
  • Question
XL 2019 Mail d'alerte automatique contenant tableau si condition remplie
Réponses
2
Affichages
796
fanch55
fanch55
Azuveus
  • Question
Microsoft 365 VBA - Save mail sur hard disk après envoi du mail
Réponses
0
Affichages
767
Azuveus
Azuveus

Membres actuellement en ligne

18 membres et 98 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 091
Messages
2 116 117
Membres
112 664
dernier inscrit
jujubaroude