Range to html/range to mail CDO avec ou sans style CSS

**patricktoulon** · 12/06/2015, 15h53

Bonjour a tous

comme je me suis aperçu que le sujet revenait souvent ces derniers temps j'ai repris mon(" grille to html " dans une autre contribution)et je l'ai complètement repensé et surtout amélioré

alors voila
1 ere fonction "RangE_tO_HTML"

je l'ai complètement réécrite et je l'ai affuble d'une fonction supplémentaire ce qui n'était pas le cas dans ma précédente contribution

2 fonction "BYSPAN"
en effet j'ai créé la fonction "BYSPAN" qui permet de gérer les caractères différent dans une même cellule( fontsize,fontname,fontcolor,etc.....)

3 fonction "bordures"
elle aussi je l'ai complétement repensé
elle intègre le code CSS pour les bordures de cellules
bien évidement elle gère mieux le type et toutes les propriétés des bordures (plus de choix de style ,etc....)

4 fonction "CSs_outline"
la fonction CSs_outline qui permet de séparer le code css du code html et redonner au balises HTML une lisibilité plus propre
et dans le cadre de l'utilisation de la sub mail on a la possibilité d'ajouter le texte dans le body du document

5 la sub "sending_mail_CDO"
et enfin la sub "sending_mail_CDO" qui permet d'envoyer la plage percidé en paramètre a un ou plusieurs destinataires
a vous bien évidement de modifier les paramètres (serveur smtp, émetteur , destinataire ,titre du sujet, texte avant la grille, après la grille ,etc....) les possibilité n'ont presque pas de limite

allons y !:
fonction "RangE_tO_HTML"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Function RangE_tO_HTML(plage)
    Dim dicorange, codehtml, matable, elem, ligne As Long, i As Long, e As Long, cel As Range, aligne As String, valigne As String
    Set dicorange = CreateObject("Scripting.Dictionary")
    With CreateObject("htmlfile")
        For i = 1 To plage.Rows.Count
            codehtml = codehtml & "<TR class= ligne" & i & ">"
            For e = 1 To plage.Columns.Count
                If Not dicorange.exists(plage.Cells(i, e).MergeArea.Address) Then
                    dicorange(plage.Cells(i, e).MergeArea.Address) = ""
                    If Not IsNull(plage.Cells(i, e).Font.Color) Or plage.Cells(i, e).Font.Name = "" Then
                        codehtml = codehtml & "<TD" & " id= " & plage.Cells(i, e).MergeArea.Address & ">" & plage.Cells(i, e).Value & "</TD>"
                    Else
                        codehtml = codehtml & "<TD" & " id= " & plage.Cells(i, e).MergeArea.Address & ">" & BYSPAN(plage.Cells(i, e).Cells(1)) & "</TD>"
                    End If
                End If
            Next
            codehtml = codehtml & vbCrLf & "</TR>" & vbCrLf
        Next
        .body.innerhtml = "<table>" & vbCrLf & Replace(codehtml, "></TD>", ">&nbsp;</TD>") & vbCrLf & "</table>" & vbCrLf & "<html>"
        Set matable = .getelementsbytagname("table")(0)
        matable.cellpadding = 0: matable.cellspacing = 0:
        'matable.Style.Bordercollapse = "collapse"
        matable.Style.letterspacing = 1
        For Each elem In .all
            Select Case elem.tagname
            Case "TD"
                elem.colspan = Range(elem.ID).Columns.Count
                elem.rowspan = Range(elem.ID).Rows.Count
                With elem.Style
                    Set cel = Range(elem.ID).Cells(1)
                    .backgroundcolor = coul_XL_to_coul_HTMLX(Range(elem.ID).Interior.Color)
                    aligne = cel.HorizontalAlignment
                    .TextAlign = Switch(aligne = -4131, "Left", aligne = -4152, "Right", aligne = -4108, "Center", aligne = 1, "Left")
                    valigne = Range(elem.ID).VerticalAlignment
                    .verticalAlign = Switch(valigne = -4160, "top", valigne = -4107, "bottom", valigne = -4108, "middle")
                    .Width = cel.Width * 96 / 72
                    .Height = cel.Height * 96 / 72
                    If elem.Children.Length = 0 Then
                        .Color = coul_XL_to_coul_HTMLX(cel.Font.Color)
                        .FontWeight = IIf(cel.Font.Bold, "Bold", "normal")
                        .fontFamily = cel.Font.Name
                        .FontStyle = IIf(cel.Font.Italic = True, "italic", "normal")
                        .FontSize = cel.Font.Size - 1 & "pt"
                    End If
                    bordures elem, plage    ' mise en place des bordures
                End With
            Case "SPAN"
                Debug.Print elem.classname
                elem.Style.FontStyle = IIf(InStr(LCase(elem.classname), "italique") > 0, "italic", "normal")
                elem.Style.Color = coul_XL_to_coul_HTMLX(Split(elem.classname, "_")(0))
                elem.Style.fontFamily = Split(elem.classname, "_*")(1)
                elem.Style.FontSize = IIf(InStr(elem.classname, "fsise") > 1, Right(elem.classname, 2) & "pt", "")
                elem.Style.FontWeight = IIf(InStr(elem.classname, "Gras") > 0, "bold", "normal")
                elem.classname = ""
            End Select
        Next
        RangE_tO_HTML = .body.innerhtml
    End With
End Function

fonction "BYSPAN"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Function BYSPAN(cel)
    Dim couleur As String, sfont As String, foname As String, fsize As String, Lclass As String, Lclass2 As String, Lespan As String, e As Long
    couleur = cel.Characters(Start:=1, Length:=1).Font.Color
    sfont = Replace(cel.Characters(Start:=1, Length:=1).Font.FontStyle, " ", "_")
    foname = cel.Characters(Start:=1, Length:=1).Font.Name
    fsize = "0" & Round(cel.Characters(Start:=1, Length:=1).Font.Size) - 1
    Lclass = couleur & "_" & sfont & "_*" & foname & "_*fsise" & fsize
    Lespan = "<SPAN class= " & Replace(Lclass, " ", "") & " >" & Replace(cel.Characters(Start:=1, Length:=1).Text, " ", "<FONT>&nbsp;</FONT>")
    For e = 2 To Len(cel.Value)
        couleur = cel.Characters(Start:=e, Length:=1).Font.Color
        sfont = Replace(cel.Characters(Start:=e, Length:=1).Font.FontStyle, " ", "_")
        foname = cel.Characters(Start:=e, Length:=1).Font.Name
        fsize = "0" & Round(cel.Characters(Start:=e, Length:=1).Font.Size) - 1
        Lclass2 = couleur & "_" & sfont & "_*" & foname & "_*fsise" & fsize
        If Lclass2 = Lclass Then
            Lespan = Lespan & Replace(cel.Characters(Start:=e, Length:=1).Text, " ", "<FONT>&nbsp;</FONT>")
        Else
            Lespan = Lespan & "</SPAN><SPAN  class= " & Replace(Lclass2, " ", "") & " >" & cel.Characters(Start:=e, Length:=1).Text
            Lclass = Lclass2
        End If
    Next
    BYSPAN = Lespan & "</SPAN> "
End Function

fonction bordures

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function bordures(elem, plage)
    Dim cel As Range, coté, e As Long, LsTyLe As String, Eptrait, StyleB, CouleurB
    Set cel = Range(elem.ID)
    coté = Array(, xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
    For e = 1 To UBound(coté)
        LsTyLe = Replace(cel.borders(coté(e)).LineStyle & cel.borders(coté(e)).Weight, "-", "")
        Eptrait = Switch(LsTyLe = 41182, 2, LsTyLe = 41152, 1, LsTyLe = 41154138, 2, LsTyLe = 44138, 3, LsTyLe = 12, 1, LsTyLe = 14138, 2, LsTyLe = 14, 3, LsTyLe = 41422, 1, LsTyLe = 41194, 3)
        StyleB = Switch(LsTyLe = 41182, "dotted", LsTyLe = 41152, "dotted", LsTyLe = 41154138, "dashed", LsTyLe = 44138, "dashed", LsTyLe = 12, "solid", LsTyLe = 14138, "solid", LsTyLe = 14, "solid", LsTyLe = 41422, "solid", LsTyLe = 41194, "double")
        CouleurB = IIf(cel.borders(coté(e)).LineStyle = xlNone, coul_XL_to_coul_HTMLX(15853019), coul_XL_to_coul_HTMLX(cel.borders(coté(e)).Color))
        If cel.borders(coté(e)).LineStyle = xlNone Then Eptrait = 1: StyleB = "solid"
        Select Case e
        Case 1
            If cel.Column = plage.Column Then elem.Style.Borderleft = Eptrait & "px " & StyleB & "  " & CouleurB
        Case 2
            elem.Style.Borderright = Eptrait & "px " & StyleB & "  " & CouleurB
        Case 3
            If cel.Row = plage.Row Then elem.Style.Bordertop = Eptrait & "px " & StyleB & "  " & CouleurB
        Case 4
            elem.Style.Borderbottom = Eptrait & "px " & StyleB & "  " & CouleurB
        End Select
    Next
End Function

edit visiblement le post est trop long en fin voila
6 la fonction css_outline

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Public Function CSs_outline(code, Optional codeht, Optional codestyle)
    Dim iedoc, dicostyle, css, elem, a, i, codehtml, lestyle
    Set iedoc = CreateObject("htmlfile")
    Set dicostyle = CreateObject("Scripting.Dictionary")
    codehtml = code
    With iedoc
        .body.innerhtml = code
        For Each elem In .all
            If InStr(elem.outerhtml, "style=") > 0 Then css = Split(Split(elem.outerhtml, "style=""")(1), Chr(34))(0)
            If Not dicostyle.exists(css) Then
                a = a + 1
                dicostyle(css) = "Style" & a
            End If
            codehtml = Replace(codehtml, "style=""" & css, "class= " & dicostyle(css))
            Debug.Print Replace(elem.outerhtml, "style=""" & css, "class= " & dicostyle(css))
        Next
        codehtml = Replace(codehtml, """", "")
        For Each elem In dicostyle
            lestyle = lestyle & vbCrLf & "." & dicostyle(elem) & "{" & Replace(elem, ";", ";" & vbCrLf & "    ") & vbCrLf & "}" & vbCrLf
        Next
        codestyle = "<style>" & lestyle & "</style>"
        codeht = codehtml
        CSs_outline = "<!DOCTYPE HTML>" & vbCrLf & "<html>" & vbCrLf & "<head>" & vbCrLf & codestyle & vbCrLf & codeht & vbCrLf & "</head>" & vbCrLf & "<body>"
    End With
End Function

7 J OUBLIAIS LA FONCTION COULEUR HTML

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function coul_XL_to_coul_HTMLX(couleur)
    Dim str0 As String, str As String
    'If couleur = 16777215 Then couleur = vbWhite
    str0 = Right("000000" & Hex(couleur), 6)
    str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
    coul_XL_to_coul_HTMLX = "#" & str & ""
End Function

maintenant quelques exemple d'utilisation

créer un fichier html sans séparer le code css du code html

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub createfich_HTML_css_inline()
    Dim intFic As Integer, plage As Range, texte As String, chemin As String
    Set plage = Range("A1:d5")
    chemin = "C:\Users\" & Environ("UserName") & "\Desktop\" & Replace(plage.Address, ":", "-") & ".html"
    texte = "<!DOCTYPE HTML>" & vbCrLf & "<HTML>" & vbCrLf & "<BODY>" & RangE_tO_HTML(plage) & vbCrLf & "</BODY>" & "<HTML>"
    intFic = FreeFile
    Open chemin For Output As intFic
    Print #intFic, texte
    Close intFic
    'Debug.Print texte
End Sub

créer un fichier html en séparant le code css du code html

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub createfich_HTML_css_outline()
    Dim intFic As Integer, plage As Range, chemin As String, texte As String, code As String
    Set plage = Range("A1:d5")
    chemin = "C:\Users\" & Environ("UserName") & "\Desktop\" & Replace(plage.Address, ":", "-") & ".html"
    texte = RangE_tO_HTML(plage)
    code = CSs_outline(texte)
    intFic = FreeFile
    Open chemin For Output As intFic
    Print #intFic, code
    Close intFic
End Sub

récupérer le style css ou le code html de la plage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Sub recupcode_css_html()
'recup le code css et html séparéSet plage = Range("A1:d5")
    Dim code As String, plage As Range, codehtml As String, codestyle As String
    Set plage = Range("A1:d5")
    code = RangE_tO_HTML(plage)
    CSs_outline code, codehtml, codestyle
    MsgBox codehtml    ' donne le code html de la table correspondant a la plage sans le style
    MsgBox codestyle    ' donne le code style css  de la table correspondant a la plage
 
End Sub

et enfin le mail

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Option Explicit
Sub sending_mail_CDO()
    Dim iMsg As Object, iConf As Object, Flds As Object, serveur, destinataire, emetteur, sujet, code, codehtml, codestyle, plage
    Dim debtexte, fintexte, pagefooter, message
    debtexte = "Bonjour voici le tableau que vous m'avez demandé; il represente le récapitulatif du mois  du mois; "
    fintexte = " Vous souhaitant bonne reception ;je reste a votre disposition pour de plus amples renseignements;"
    pagefooter = "mon entreprise;Cordialement;;moi@live.com"
 
    serveur = "smtp.orange.fr"
    destinataire = "l'autre@hotmail.fr"
    emetteur = "moi@live.com"
    sujet = "essaie de mail "
 
    'récupération du code html correspondant a la plage
    Set plage = Range("A1:d5")
    code = RangE_tO_HTML(plage)    'on créé le code avec le style inline(dans les balises html)
    CSs_outline code, codehtml, codestyle    ' on separe le code html du code CSS
    message = "<!DOCTYPE HTML>" & vbCrLf & "<HTML>" & vbCrLf & "<head>" & vbCrLf & codestyle & "</head>" & vbCrLf & "</BODY>"
    message = message & Replace(debtexte, ";", "<BR>")
    message = message & codehtml & vbCrLf & "<BR>"
    message = message & Replace(fintexte, ";", "<BR>")
    message = message & Replace(pagefooter, ";", "<BR>")
    message = message & "</BODY></HTML>"
    Set iMsg = CreateObject("cdo.message")
    Set iConf = CreateObject("cdo.configuration")
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'remplacez "serveur" par le nom de serveur smtp de votre FAI si vous utilisez pas la variable serveur
        'http://outlook.developpez.com/faq/index.php?page=Configuration#Paras_FAI
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = serveur
        .Update
    End With
    With iMsg
        Set .Configuration = iConf
        .To = destinataire
        .From = emetteur
        .Subject = sujet
        .HTMLBody = message
        ' .AddAttachment 'c:\mon dossier\monfichier.extention"
        .Send
    End With
    MsgBox "Le message a été envoyé"
End Sub

vous me direz a quoi ca sert sachant que l'on peut enregistrer une feuille un classeur , une sélection de cellules en HTML cette fonction existe
je vous répondrais avec ces 2 capture s
fait le avec Excel et avec ma méthode et comparez vous comprendrez

capture excel
Pièce jointe 180436

capture dans mon Outlook
Pièce jointe 180438

voila le résultat parle pour moi

vous avez plus qu'a mettre toutes ces fonctions dans un module et vous en servir
Bonne utilisation

qu'en pensez vous ??

**Friberg59** · 22/10/2018, 15h19

Bonjour Patrick,

Un grand merci pour ces fonctions et propositions d'utilisation que j'ai pu intégrer avec quelques aménagements et ce sans aucune difficulté

Juste une remarque car je n'ai pas réussi à retrouver la contribution que tu évoques dans ton introduction "...j'ai repris mon (" grille to html " dans une autre contribution)", et pour info les liens en bas de page vers les captures ne fonctionnent pas

Félicitations pour tous tes travaux sur ce site !!!

**Dan38** · 13/12/2018, 16h12

Bonjour Patrick

Très beau travail
J'ai utilisé tes outils pour aider à diffuser un mail à différentes bénévoles de l'association en fonction de personnes à visiter. Récemment j'ai perdu la fonctionnalité "Dictionnaire" surement à cause d'un blocage de l'IT de la référence "Microsoft Stripping Runtime".

j'essaie de ré-écrire ta Function RangE_tO_HTML(plage), changer Set dicorange = CreateObject("Scripting.Dictionary") par Set dicorange = New Collection, jusque là ça va.

Par contre je coince pour la suite : With CreateObject("htmlfile"), qu'écrire pour que cette fonction utilise les collections, même si c'est moins rapide

Par avance merci

**patricktoulon** · 13/12/2018, 21h03

re
oulahhhh elle est vielle celle la il faudrait que je la rafraichisse
depuis j'utilise meme plus de dictionaire maintenant je me sert du test d'existence dans le document html directement
une sub de demo de base sans style

on a plus besoins de dictionaire ....!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub test()
    Dim plage, dochtml, TD, TR, TBODY
    Set plage = Sheets(1).Range("A1:F10")
    Set dochtml = CreateObject("htmlfile")
    With dochtml
        .body.innerhtml = "<table><TBODY></TBODY></TABLE>": Set TBODY = .getElementsByTagName("TABLE")(0).Children(0)
        For lig = 1 To plage.Rows.Count
            Set TR = .createelement("tr")
            TBODY.appendchild (TR)
            For col = 1 To plage.Columns.Count
                Set cel = plage.Cells(lig, col)
                If .getelementById(cel.MergeArea.Address(0, 0)) Is Nothing Then
                    Set TD = .createelement("td")
                    TD.iD = cel.MergeArea.Address(0, 0)
                    r = TD.setattribute("ColoN", plage.Cells(lig, col).Column)
                    TD.rowspan = cel.MergeArea.Rows.Count
                    TD.colspan = cel.MergeArea.Columns.Count
                    ' on ajoute atribut ou style ou ce que tu veux au td ici
                    '
                    '
                    TR.appendchild (TD)
                End If
            Next
        Next
        Debug.Print .body.innerhtml
    End With
End Sub

attention c'est une base hein entendons nous bien ,pas aussi complete que la precedente
c'est juste pour te montrer que je n'utilise plus d'object dico
je le ferais demain la version complete en fonction

**Dan38** · 13/12/2018, 21h10

Effectivement je viens de voir en lisant ta réponse : 2015

Merci d'avance de plancher sur cette mise à jour
A+

**patricktoulon** · 13/12/2018, 21h33

pas de soucis
je sais meme pas pourquoi je ne l'ai pas deja fait
mes codes sont beaucoup plus generiques maintenant

**Dan38** · 03/01/2019, 20h42

Bonjour,
Meilleurs voeux pour une année riche en satisfaction et pleine de plaisir.

Avez vous pu finaliser la mise à jour de cette fonction

Merci

**patricktoulon** · 03/01/2019, 21h51

re
non pas encore
j'ai bien avancer sur la construction de la table html sans dictionnaire par contre mais c'est pas fini
j'en suis la

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Sub test()
    Set plage = Sheets(1).Range("A1:F10")
 
    With CreateObject("internetexplorer.application")
        .navigate "about:blank": .Visible = True
        .document.write Range_To_Html(plage)
    End With
End Sub
 
Function Range_To_Html(plage)
    Dim dochtml, TD, TR, TBODY, ptopx#
    ptopx = PointToPixel
    Set dochtml = CreateObject("htmlfile")
    With dochtml
        .body.innerhtml = "<table><TBODY></TBODY></TABLE>": Set TBODY = .getelementsbytagname("TABLE")(0).Children(0)
        With .getelementsbytagname("TABLE")(0)
            .Style.bordercollapse = "collapse"
            .cellspacing = 0
            .Style.FontSize = ThisWorkbook.Styles(1).Font.Size & "pt"
            .Style.Fontfamily = ThisWorkbook.Styles(1).Font.Name
        End With
        For lig = 1 To plage.Rows.Count
            Set TR = .createelement("tr")
            TBODY.appendchild (TR)
            For col = 1 To plage.Columns.Count
                Set cel = plage.Cells(lig, col)
                If .getelementbyid(cel.MergeArea.Address) Is Nothing Then
                    Set TD = .createelement("td")
                    TD.ID = cel.MergeArea.Address
                    r = TD.setattribute("ColoN", plage.Cells(lig, col).Column)
                    TD.rowspan = cel.MergeArea.Rows.Count
                    TD.colspan = cel.MergeArea.Columns.Count
                    TD.innerhtml = "<font>" & cel.Text & "</font>"
                     TD.Children(0).innerhtml = textFormat(cel)
 
                    ' on ajoute atribut ou style ou ce que tu veux au td ici
                    TD.Children(0).Style.margin = "2px"
 
                    With TD.Style
                        .Width = Round(cel.MergeArea.Width * ptopx) & "px"
                        .Height = Round(cel.MergeArea.Height * ptopx) & "px"
                        If cel.Interior.Color <> vbWhite Then .backgroundcolor = coul_XL_to_coul_HTMLX(cel.Interior.Color)
                        '.FontSize = cel.Font.Size & "pt"
                        'alignement du texte
                        aligne = cel.HorizontalAlignment
                        .TextAlign = Switch(aligne = -4131, "Left", aligne = -4152, "Right", aligne = -4108, "Center", aligne = 1, "Left")
                        valigne = cel.VerticalAlignment
                        .verticalAlign = Switch(valigne = -4160, "top", valigne = -4107, "bottom", valigne = -4108, "middle")
                        .Border = "1px solid black"
                    End With
                    TR.appendchild (TD)
                End If
            Next
        Next
        Range_To_Html = .body.innerhtml
    End With
End Function
'--------------------------------------------------------------------------------------
Public Function coul_XL_to_coul_HTMLX(couleur)
    Dim str0 As String, str As String
    'If couleur = 16777215 Then couleur = vbWhite
    str0 = Right("000000" & Hex(couleur), 6)
    str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
    coul_XL_to_coul_HTMLX = "#" & str & ""
End Function
Function PointToPixel()
With ActiveWindow.ActivePane
PointToPixel = (.PointsToScreenPixelsY(Cells.Height) - ActiveWindow.ActivePane.PointsToScreenPixelsY(0)) / Cells.Height
End With
End Function
'Récupération du texte formaté de la cellule dans le xmlvalue
Function textFormat(cel)
     Set doc = CreateObject("htmlfile")
     doc.body.innerhtml = "<div id= ""aa""></div>"
     doc.getelementbyid("aa").innerhtml = cel.Value(xlRangeValueXMLSpreadsheet)
   doc.body.innerhtml = Replace(doc.getelementsbytagname("data")(0).innerhtml, "html:", "")
 
   Set mesfont = doc.getelementsbytagname("FONT")
    For i = 0 To mesfont.Length - 1
 
    If mesfont(i).Size <> "" Then mesfont(i).Size = Round(mesfont(i).Size / 3) Else mesfont(i).Size = 2
   Next
   If cel.Font.Bold Then textFormat = "<b>" & doc.body.innerhtml & "</b>" Else textFormat = doc.body.innerhtml
   If cel.Font.Color <> vbBlack Then textFormat = "<font color=" & coul_XL_to_coul_HTMLX(cel.Font.Color) & " >" & doc.body.innerhtml & "</font>" Else textFormat = doc.body.innerhtml
 
   'textFormat = doc.body.innerhtml
End Function