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 : 4221
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

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

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager