Autres Générer un mail depuis Excel à travers une VBA

hse

XLDnaute Nouveau
Bonjour à tous,

J'ai trouvé un code VBA pour pouvoir générer un mail automatique depuis Excel.

Le seul souci que j'ai, est que le 'Body' du mail est sur plusieurs lignes

vba excel 1
J'aimerai que les lignes de D6 à D12 soit repris dans l'ordre dans le corp de mon mail.

J'utilise la fonction Body = Range ("D6"), ce que je veux, c'est que les cellles D6, D7, D8, D9, D10, D11 et D12 soit repris dans mon mail et dans l'ordre ligne par ligne.

vba excel 2
ce que je souhaite, c'est d'avoir le mail ci dessous en automatique

vba excel 3

Exemple ci-joint, pouvez vous m'aider SVP ?

Cordialement :)
 

Pièces jointes

  • Mail depuis Excel.xlsm
    24.3 KB · Affichages: 21

patricktoulon

XLDnaute Barbatruc
bonjour
VB:
Private Sub CommandButtonl_Click()
Dim Lemail As Variant
Set Lemail = CreateObject("Outlook.Application") 'creating an Outlook object
With Lemail.CreateItem(olMailItem)
    .Subject = Range("D5")
    .To = Range("H2")
    .Body = Join(Application.Transpose([D6:D12]), vbCrLf)
    .Display
End With
End Sub
 

patricktoulon

XLDnaute Barbatruc
bonjour Staple1600
si t'insiste
ben tu passe en htmlbody
le temps de sortir ma gouache et mes pinceaux
VB:
Private Sub CommandButtonl_Click()
Dim Lemail As Variant
Set Lemail = CreateObject("Outlook.Application") 'creating an Outlook object
With Lemail.CreateItem(olMailItem)
    .Subject = Range("D5")
    .To = Range("H2")
   
    t = Application.Transpose([D6:D12])
    t(1) = "<b>" & t(1) & "</b>" & "<br/>"
    t(2) = "<font color=red><em>" & t(2) & "</em></font>"
    t(3) = "<div style=""background-color:cyan;color:rgb(150,150,0)"">" & t(3)
    t(4) = t(4) & "</div>" & "<br/>"
    t(5) = "<div style=""background-color:orange;color:rgb(0,0,255)""><b><em><u>" & t(5) & "<u><em><b>"
    t(6) = t(6) & "</div>" & "<br/>"
   
    .htmlBody = Join(t)
    .Display
End With
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Euh, moi je n'insiste pas.
Le message#4 était là pour la saluer l'émetteur de message#3 qui n'avait pu passé le message#2
Mais une fois les satuations faites, fallait bien que l'émetteur des messages#2#4#6 dise un truc en rapport avec la question cise en message#1
;)
 

patricktoulon

XLDnaute Barbatruc
apres on peut tout formater dans les cellule comme on le veut et recupérer le html comme je l'ai deja montré
ca evite pour les moins aguerris avec le langage (html/css (inline) ) ne se prendre la tète

je le redonne au cas ou ça intéresse
voici comment on recupere le texte avec le formatage EN HTML
VB:
Function HtmlTextCode(cel)
    With CreateObject("htmlfile")
        code = Replace(Replace(cel(1).Value(xlRangeValueXMLSpreadsheet), "Cell", "Div"), "html:", "")
        .Body.innerhtml = code
        Set div = .getelementsbytagname("DIV")(0)
        If div.ChildNodes.Length > 0 Then x = div.ChildNodes(0).innerhtml Else x = div.innerhtml
        .Body.innerhtml = "<font face=""calibri"">" & Replace(x, "color=#000000", "") & "</font>"
        Set Fonts = .getelementsbytagname("FONT")
        For Each elem In Fonts
            fz = Val(elem.getattribute("size"))
            If fz > 0 Then elem.Style.FontSize = Val(elem.getattribute("size")) & "pt"
            elem.removeattribute ("size")
        Next
        Fonts(0).Style.FontSize = "11pt"
        HtmlTextCode = .Body.innerhtml
    End With
End Function

juste pour tester avec le visuel dans ( I E )
VB:
Sub testhtmltext()
    code = HtmlTextCode([A1])
    With CreateObject("internetexplorer.application")
        .Visible = True
        .navigate "about:blank"
        .document.write code
    End With
End Sub

c'est zzzzzoly!!!!!
Capture.JPG


pour ceux qui sont curieux voici le code obtenu
HTML:
<FONT style="FONT-SIZE: 11pt" face=calibri><FONT face=Algerian x:Family="Decorative">DU</FONT><FONT> </FONT><B><I><FONT color=#ff0000 face="Blackadder ITC" x:Family="Decorative">TEXTE</FONT></I></B><FONT> </FONT><B><I><FONT color=#538dd5>en</FONT></I></B><FONT> </FONT><FONT color=#da9694 face=Broadway x:Family="Decorative">co</FONT><FONT color=#4bacc6 face=Broadway x:Family="Decorative">u</FONT><FONT color=#ffff00 face=Broadway x:Family="Decorative">leu</FONT><FONT color=#ff0000 face=Broadway x:Family="Decorative">r</FONT><FONT> formaté joli joli </FONT></FONT>
 

patricktoulon

XLDnaute Barbatruc
re
a ben moi je travaille avec WindoWs, les machistes passez votre chemin ils n'ont qu'a pas avoir (le cul entre deux chaises) 🤣
d'ailleurs si il le veulent ,si ils ont cette fonction activé et fonctionnelle (je parle du .value(11))
libre a eux de disséquer façon versaintclitorix en string
demo7.gif


LOL
 

patricktoulon

XLDnaute Barbatruc
tient comme c'est noel et si ils ont le .value(11) dispo) alors noyeux joel les machistes
VB:
Function HtmlCellTextCodeforMac(cel)
    Dim BD, Bfn, iD, iFn, uD, uFn, sD, sFn, cl
    code = Split(Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:", ""), "<Data")(1)
    code = Split(Mid(code, InStr(1, code, ">") + 1), "</Data>")(0)
    code = Replace(Replace(code, "html:", ""), "x:Family=""Decorative""", "")
    For I = 1 To 100: code = Replace(code, "Size=""" & I & Chr(34), "style=""font-size:" & I & "pt;"""): Next
    If cel.Font.Bold = True Then BD = "<b>": Bfn = "</b> "
    If cel.Font.Italic = True Then iD = "<i>": iFn = "</i> "
    If cel.Font.Underline > 0 Then uD = "<u>": uFn = "</u> "
    If cel.Font.Strikethrough = True Then sD = "<Strike>": sFn = "</strike>"
    If cel.Font.Color <> vbBlack Then cl = "color=" & coul_XL_to_coul_HTMLX(cel.Font.Color)
    HtmlCellTextCodeforMac = "<font style=""font-size:11pt;""" & cl & ">" & sD & iD & BD & uD & code & uFn & Bfn & iFn & sFn & "</font>"
End Function
'je test quand meme avec IE dans windows (la sub ne fonctionne sur mac )

VB:
Sub Test_HtmlCellTextCodeforMac()
    code = HtmlCellTextCodeforMac([A1])
    With CreateObject("internetexplorer.application")
        .Visible = True
        .navigate "about:blank"
        .document.write code
    End With
End Sub
edit: j'ai ajouté la couleur globale
et donc ajouté aussi la fonction couleur excel to htmlcolor
VB:
Function coul_XL_to_coul_HTMLX(couleur)
    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:

Discussions similaires

Statistiques des forums

Discussions
314 719
Messages
2 112 181
Membres
111 452
dernier inscrit
christine64