Convertir la mise en forme d'une cellule excel en html

**ben_ghost** · 07/11/2007, 14h02

Bonjour,

En gros j'aimerais obtenir pour une cellule contenant :

avant éxécution de la macro :

Code :

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

Je m appelle Ghost

aprés exécution de la macro :

Code :

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

je m appelle [ B]Ghost[ /B]

les données seront ensuite envoyé a un site internet mais il s'agit d'un progiciel je n'est donc pas la main sur celui.

je sais qu'il est possible d'enregistrer une page word au format HTML de ce fait y a t'il une fonction déjà existante la dessus ?

Merci

**fred65200** · 07/11/2007, 18h57

bonjour, le code pour enregistrer un classeur xls en htlm

Code :

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

1
2
3
 
    ActiveWorkbook.SaveAs Filename:="C:\Users\XXXX\Desktop\Classeur1.htm", _
        FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False

cordialement

**ben_ghost** · 08/11/2007, 09h41

Merci Fred mais ce n'est pas exactement ça que j'esperais mais j'ai réussi à me débrouillé tout seul en gros je voulais pouvoir convertir UNE cellule.

Donc j'ai du faire mon propre convertisseur. Le voila au cas ou certaines personnes serait interessé :

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Sub CréationBalise()
    Dim cell As Range
 
    For Each cell In Selection
        Dim ColorDefault As Integer
        ColorDefault = -4105
        Dim d As Integer        ' counter
        Dim s As String         ' tanpom
        Dim B As Boolean        ' for BOLD
        Dim U As Boolean        ' for underline
        Dim I As Boolean        ' for Italic
        Dim C As Long           ' for Color
        C = ColorDefault
 
        s = "<html><body>"
        For d = 1 To Len(cell.Value) Step 1
            If cell.Characters(d, 1).Font.Bold = True Then                          ' Gestion Du gras
                If B = False Then                                                   '
                    s = s + "<b>"                                                   '
                    B = True                                                        '
                End If                                                              '
            End If                                                                  '
            If cell.Characters(d, 1).Font.Bold = False And B = True Then            '
                s = s + "</b>"                                                      '
                B = False                                                           '
            End If                                                                  '
 
            If cell.Characters(d, 1).Font.Underline = xlUnderlineStyleSingle Then                     ' Gestion du soulignement
                If U = False Then                                                   '
                    s = s + "<u>"                                                   '
                    U = True                                                        '
                End If                                                              '
            End If                                                                  '
            If cell.Characters(d, 1).Font.Underline = xlUnderlineStyleNone And U = True Then       '
                s = s + "</U>"                                                      '
                U = False                                                           '
            End If                                                                  '
 
            If cell.Characters(d, 1).Font.Italic = True Then                        ' Gestion de l'italique
                If I = False Then                                                   '
                    s = s + "<i>"                                                   '
                    I = True                                                        '
                End If                                                              '
            End If                                                                  '
            If cell.Characters(d, 1).Font.Italic = False And I = True Then          '
                s = s + "</i>"                                                      '
                I = False                                                           '
            End If                                                                  '
 
            If cell.Characters(d, 1).Font.ColorIndex <> ColorDefault Then           ' Gestion de la couleur
                Dim Rouge, Vert, Bleu As Integer
 
                Rouge = Int(cell.Characters(d, 1).Font.ColorIndex Mod 256)
                Vert = Int((cell.Characters(d, 1).Font.ColorIndex Mod 65536) / 256)
                Bleu = Int(cell.Characters(d, 1).Font.ColorIndex / 65536)
 
 
 
                If cell.Characters(d, 1).Font.ColorIndex <> C And C <> ColorDefault Then
                    s = s + "</font>"
                    s = s + "<font color=#""" + Format(Hex(Rouge), "##00") + Format(Hex(Vert), "##00") + Format(Hex(Bleu), "##00") + """>"
                    C = cell.Characters(d, 1).Font.ColorIndex                                                               '
                ElseIf C = ColorDefault And cell.Characters(d, 1).Font.ColorIndex <> ColorDefault Then
                    s = s + "<font color=#""" + Format(Hex(Rouge), "##00") + Format(Hex(Vert), "##00") + Format(Hex(Bleu), "##00") + """>"
                    C = cell.Characters(d, 1).Font.ColorIndex                                                        '
                End If
            End If
            If cell.Characters(d, 1).Font.ColorIndex = ColorDefault And C <> ColorDefault Then
                    s = s + "</font>"
                    C = ColorDefault
            End If '
 
            s = s + Right(Left(cell.Value, d), 1)
        Next
 
        If B = True Then
            s = s + "</b>"
            B = False
        End If
        If U = True Then
            s = s + "</u>"
            U = False
        End If
        If I = True Then
            s = s + "</i>"
            I = False
        End If
        If C <> ColorDefault Then     '
                s = s + "</font>"                                                      '
                C = ColorDefault                                                           '
        End If
 
        's = Replace(s, """", "&quot;")
        's = Replace(s, "&", "&amp;")
        ' Rétablissement des "&quot;", modifiés par la ligne RemplaceCar "&", "&amp;"
        's = Replace(s, "&amp;quot", "&quot")
        s = Replace(s, "à", "&agrave;")
        s = Replace(s, "é", "&eacute;")
        s = Replace(s, "è", "&egrave;")
        s = Replace(s, "ê", "&ecirc;")
        s = Replace(s, "î", "&icirc;")
        s = Replace(s, "ô", "&ocirc;")
        s = Replace(s, "ù", "&ugrave;")
 
        cell.Value = s + "</body></html>"
 
    Next
End Sub

**patricktoulon** · 07/08/2017, 18h28

bonjour
cherche avec mon pseudo dans les contributions ma contrib grille to html
tu a tout dedans même la conversion code couleur excel en code couleur html

**patricktoulon** · 07/08/2017, 18h40

Basé sur ma derniere contribution
voila ceci va te restitué dans un document html la meme chose en tout points (fontss,bold,italic,underline,couleur size)

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
Sub test()
MsgBox text_formaté(Cells(1, 1))
End Sub
Function Pt_To_Px()
With CreateObject("WScript.Shell"): Pt_To_Px = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
End Function
 
Public Function coul_XL_to_coul_HTMLX(couleur)
    Dim str0 As String, str As String
    Debug.Print couleur
    '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 text_formaté(cel)
    Dim F, Doc, L, formt, mot, forma, font, i As Long
    Set Doc = CreateObject("htmlfile")
    Doc.write "<br><div id=""mot""></div>"
    F = ""
    ppx = Pt_To_Px
    With Doc
        Set mot = .getelementbyid("mot")
        If IsDate(cel.Value) Then
            forma = cel.NumberFormat
            d = Trim(Replace(Format(cel.Value, forma), ",", ""))
            Set font = .createElement("FONT")
            font.innerhtml = IIf(cel.font.Italic, "<em>" & d & "</em>", Format(cel.Value, forma))
            font.innerhtml = IIf(cel.font.Bold, "<strong>" & font.innerhtml & "</strong>", d)
            font.Color = coul_XL_to_coul_HTMLX(cel.font.Color): font.face = cel.font.Name: font.Style.FontSize = Round(cel.font.Size * ppx) - 1 & "px "
            text_formaté = font.outerhtml: Exit Function
        End If
        If IsNumeric(cel.Value) Then
            Set font = .createElement("FONT")
            font.innerhtml = IIf(cel.font.Italic, "<em>" & cel.Value & "</em>", cel.Value)
            font.innerhtml = IIf(cel.font.Bold, "<strong>" & font.innerhtml & "</strong>", cel.Value)
            font.Color = coul_XL_to_coul_HTMLX(cel.font.Color): font.face = cel.font.Name: font.Size = Round(cel.font.Size * ppx) & "px "
            text_formaté = font.outerhtml: If cel.NumberFormat <> "@" Then Exit Function
        End If
        For i = 1 To Len(cel.Value)
            L = CStr(cel.Characters(Start:=i, Length:=1).Text)
            formt = "size=" & Round(cel.Characters(Start:=i, Length:=1).font.Size / 3) & "pt " & "face=""" & cel.Characters(Start:=i, Length:=1).font.Name & Chr(34) & " "
            formt = formt & "color=""" & coul_XL_to_coul_HTMLX(cel.Characters(Start:=i, Length:=1).font.Color) & Chr(34) & ">"
            If F <> formt Then
                Set font = .createElement("FONT"): F = formt
                font.Color = coul_XL_to_coul_HTMLX(cel.Characters(Start:=i, Length:=1).font.Color)
                font.face = cel.Characters(Start:=i, Length:=1).font.Name
                font.Size = Round(cel.Characters(Start:=i, Length:=1).font.Size / 3) & "px "
            End If
            If cel.Characters(Start:=i, Length:=1).font.Italic = True Then L = "<em>" & L & "</em>"
            If cel.Characters(Start:=i, Length:=1).font.Bold = True Then L = "<strong>" & L & "</strong>"
            font.innerhtml = font.innerhtml & L
            mot.appendchild (font)
        Next
        text_formaté = Replace(mot.innerhtml, "</STRONG><STRONG>", "")
        'Debug.Print Replace(mot.innerhtml, "</STRONG><STRONG>", "")
    End With
    Set Doc = Nothing
End Function

Nom : Capture.JPG
Affichages : 3881
Taille : 114,3 Ko

edit:modifie la derniere ligne de la fonction ligne par celle ci

Code :

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

text_formaté = Replace(Replace(mot.innerhtml, "</STRONG><STRONG>", ""), "</EM><EM>", "")

**patricktoulon** · 07/08/2017, 19h13

re
les retours a la ligne dans une même cellule c'est le wraptext
ca existe aussi en html pour une balise div ou même cellule "<td>"
après une discussion récente dont je suis l'initiateur parle justement des lignes réelles ou pas dans une cellules dans la discussions il me semble avoir livré une fonction prêt a l'emploi

il te faut donc convertir un texte (wraptext) en texte avec saut de ligne dans la cellule excel ca change rien au visuel sur le tableau

après tu les passe a ma moulinette que je viens de présenter

et voila

**AUERFRANCOIS** · 07/08/2017, 19h41

Je viens de trouver une solution pour convertir automatiquement, sous excel, le contenu de cellule(s) "texte" en "html", tout en conservant les retours à la ligne ("Alt" + "Entrée). Il suffit d'utiliser le code de "ben_ghost" et de rajouter à la fin de son code " s = Replace(s, vbLf, "</p>") " pour les retours à la ligne. Son fonctionnement est un bon long, mais le résultat est au rendez-vous :-)

Voici son code avec la ligne de code supplémentaire :

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Sub CréationBalise()
    Dim cell As Range
 
    For Each cell In Selection
        Dim ColorDefault As Integer
        ColorDefault = -4105
        Dim d As Integer        ' counter
        Dim s As String         ' tanpom
        Dim B As Boolean        ' for BOLD
        Dim U As Boolean        ' for underline
        Dim I As Boolean        ' for Italic
        Dim C As Long           ' for Color
        C = ColorDefault
 
        s = "<html><body>"
        For d = 1 To Len(cell.Value) Step 1
            If cell.Characters(d, 1).Font.Bold = True Then                          ' Gestion Du gras
                If B = False Then                                                   '
                    s = s + "<b>"                                                   '
                    B = True                                                        '
                End If                                                              '
            End If                                                                  '
            If cell.Characters(d, 1).Font.Bold = False And B = True Then            '
                s = s + "</b>"                                                      '
                B = False                                                           '
            End If                                                                  '
 
            If cell.Characters(d, 1).Font.Underline = xlUnderlineStyleSingle Then                     ' Gestion du soulignement
                If U = False Then                                                   '
                    s = s + "<u>"                                                   '
                    U = True                                                        '
                End If                                                              '
            End If                                                                  '
            If cell.Characters(d, 1).Font.Underline = xlUnderlineStyleNone And U = True Then       '
                s = s + "</U>"                                                      '
                U = False                                                           '
            End If                                                                  '
 
            If cell.Characters(d, 1).Font.Italic = True Then                        ' Gestion de l'italique
                If I = False Then                                                   '
                    s = s + "<i>"                                                   '
                    I = True                                                        '
                End If                                                              '
            End If                                                                  '
            If cell.Characters(d, 1).Font.Italic = False And I = True Then          '
                s = s + "</i>"                                                      '
                I = False                                                           '
            End If                                                                  '
 
            If cell.Characters(d, 1).Font.ColorIndex <> ColorDefault Then           ' Gestion de la couleur
                Dim Rouge, Vert, Bleu As Integer
 
                Rouge = Int(cell.Characters(d, 1).Font.ColorIndex Mod 256)
                Vert = Int((cell.Characters(d, 1).Font.ColorIndex Mod 65536) / 256)
                Bleu = Int(cell.Characters(d, 1).Font.ColorIndex / 65536)
 
 
 
                If cell.Characters(d, 1).Font.ColorIndex <> C And C <> ColorDefault Then
                    s = s + "</font>"
                    s = s + "<font color=#""" + Format(Hex(Rouge), "##00") + Format(Hex(Vert), "##00") + Format(Hex(Bleu), "##00") + """>"
                    C = cell.Characters(d, 1).Font.ColorIndex                                                               '
                ElseIf C = ColorDefault And cell.Characters(d, 1).Font.ColorIndex <> ColorDefault Then
                    s = s + "<font color=#""" + Format(Hex(Rouge), "##00") + Format(Hex(Vert), "##00") + Format(Hex(Bleu), "##00") + """>"
                    C = cell.Characters(d, 1).Font.ColorIndex                                                        '
                End If
            End If
            If cell.Characters(d, 1).Font.ColorIndex = ColorDefault And C <> ColorDefault Then
                    s = s + "</font>"
                    C = ColorDefault
            End If '
 
            s = s + Right(Left(cell.Value, d), 1)
        Next
 
        If B = True Then
            s = s + "</b>"
            B = False
        End If
        If U = True Then
            s = s + "</u>"
            U = False
        End If
        If I = True Then
            s = s + "</i>"
            I = False
        End If
        If C <> ColorDefault Then     '
                s = s + "</font>"                                                      '
                C = ColorDefault                                                           '
        End If
 
        's = Replace(s, """", """)
        's = Replace(s, "&", "&amp;")
        ' Rétablissement des """, modifiés par la ligne RemplaceCar "&", "&amp;"
        's = Replace(s, "&amp;quot", "&quot")
        s = Replace(s, "à", "&agrave;")
        s = Replace(s, "é", "&eacute;")
        s = Replace(s, "è", "&egrave;")
        s = Replace(s, "ê", "&ecirc;")
        s = Replace(s, "î", "&icirc;")
        s = Replace(s, "ô", "&ocirc;")
        s = Replace(s, "ù", "&ugrave;")
        s = Replace(s, vbLf, "</p>")

        cell.Value = s + "</body></html>"
 
    Next
End Sub

**patricktoulon** · 08/08/2017, 17h02

le problème dans cette démarche c'est que si ta cellule est en propriété ajuster a la ligne automatiquement (wraptext)
on a donc plusieurs saut de lignes dans la cellules visible mais tu ne les trouvera pas en examinant le texte
c'est ce que j'essai de t'expliquer en vain me semble t il

Nom : Capture.JPG
Affichages : 3802
Taille : 145,9 Ko

et attention les balise b et i sont amené a disparaitre du html elles sont remplacé par strong et EM

**chercao** · 02/06/2024, 17h00

Bonjour, je cherche aussi a transformer un texte d'une cellule excel en texte html dans une nouvelle cellule, mais je ne suis pas développeuse. Je suis tombée sur vos propositions et cela m'intéresse de faire la même chose.

Pourrions nous en discuter ?
Caroline

**patmeziere** · 18/06/2024, 08h13

Bonjour
excel donne déjà la chose avec le .value(11)
reste plus qu'à faire un peu de netoyage dans le texte

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
Function htmltexte(cel As Range)
'Fonction de récupération du code html du texte formaté dans la cellule
'Patricktoulon (2016)
    Dim cde$, elem, Dc As New HTMLDocument
    cde = Replace(Replace(Replace(cel.Value(11), "ss:", ""), "Data", "Div"), "html:", "")
    cde = Replace(cde, "
", "<br>")
    With Dc
        .body.innerhtml = cde
        For Each elem In .all
            If elem.getattribute("size") <> "" Then elem.Style.FontSize = elem.getattribute("size") & "pt"
            elem.removeattribute ("size")
        Next
        htmltexte = .getelementsbytagname("div")(0).innerhtml
    End With
End Function

la formule
exemple
=htmltexte(A1]

corrige la secondes lide "cde=..." il y a la chaine du saut de ligne qui passe pas dans le post
Nom : Capture.JPG
Affichages : 46
Taille : 53,1 Ko

Nom : Capture.JPG
Affichages : 46
Taille : 53,1 Ko

Convertir la mise en forme d'une cellule excel en html

Macros et VBA Excel

Discussions similaires

Partager

Partager