Discussion :

[davido84]

C'est bon apparemment.
Sinon quand tu formates une date en date longue et que tu ajustes correctement la largeur de colonne la date apparaît dans la cellule sur la même ligne mais sur 2 lignes dans la page Web.

[patricktoulon]

bon apparemment il y a des subtilité que je n'avais pas vu
notamment selon les format les alignement null (affiché n'ont pas le même résultat dans excel ce qui forcement se répercute sur le html mais il faudrait un gros sxith pour faire avec tout les formats j'ai un peu généraliser

j'ai réduit le font size si non format "@"

j'ai donc un peu remanié le tout

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
110
111
Sub test()
    Dim IE As Object
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True
    IE.navigate "about:blank"
    IE.document.body.innerhtml = plage_to_HTML(Sheets(1).Range("B4:D12"))
End Sub
Function plage_to_HTML(plage As Range) As String
    Dim TD, TR, DOC, DICO, Table As Object, i As Long, col As Long, cel As Range, Halign, Valign
    Set DICO = CreateObject("scripting.dictionary")
    Set DOC = CreateObject("htmlfile")
    With DOC
        .body.innerhtml = "<Table></Table>"
        Set Table = .getelementsbytagname("Table")(0)
        Table.Style.Width = Round(plage.Width * 1.66666666666667) & "px"
        Table.Style.Height = Round(plage.Height * 1.66666666666667) & "px"
        Table.Style.bordercollapse = "collapse"
        Table.Style.letterSpacing = "0.3pt"
        Table.Style.display = "inline"
        For i = 1 To plage.Rows.Count
            Set TR = .createelement("TR")
            For col = 1 To plage.Columns.Count
                Set cel = plage.Cells(i, col)
                If Not DICO.exists(cel.MergeArea.Address) Then
                    DICO(cel.MergeArea.Address) = ""
                    Set TD = .createelement("TD")
                    With TD
                        .ID = cel.Address: .colspan = cel.MergeArea.Columns.Count: .rowspan = cel.MergeArea.Rows.Count
                        .innerhtml = IIf(cel.Value <> "", text_BYSPAN_format(cel), "   ")
                        With .Style
                            .FontSize = IIf(IsNull(cel.Font.Size), 20, Round(cel.Font.Size * 1.4)) & "px"
                            .fontfamily = cel.Font.Name
                            .fontweight = IIf(cel.Font.Bold = True, "Bold", "Normal")
                            .FontStyle = IIf(cel.Font.Italic = True, "italic", "normal")
                            .Color = IIf(IsNull(cel.Font.Color), 0, coul_XL_to_coul_HTMLX(cel.Font.Color))
                            .bordertop = borderstyle(cel.borders(xlEdgeTop))
                            .borderleft = borderstyle(cel.borders(xlEdgeLeft))
                            .borderbottom = borderstyle(cel.borders(xlEdgeBottom))
                            .borderright = borderstyle(cel.borders(xlEdgeRight))
                            .Width = Round(cel.Width * 1.66666666666667) & "px"
                            .Height = Round(cel.Height * 1.66666666666667) & "px"
                            .Background = coul_XL_to_coul_HTMLX(cel.Interior.Color)
                            Halign = Switch(IsNull(cel.HorizontalAlignment), "left", cel.HorizontalAlignment = xlRight, "right", cel.HorizontalAlignment = -4108, "center", cel.HorizontalAlignment = xlLeft, "left")
                            Valign = Switch(IsNull(cel.VerticalAlignment), "bottom", cel.VerticalAlignment = xlTop, "top", cel.VerticalAlignment = xlCenter, "middle", cel.VerticalAlignment = xlBottom, "bottom")
                            .textalign = IIf(IsNull(Halign), "left", Halign)
                            .verticalalign = Valign
                        End With
                    End With
                    TR.appendchild (TD)
                End If
            Next
            Table.appendchild (TR)
        Next
        plage_to_HTML = .body.innerhtml
    End With
End Function
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 borderstyle(Cote)
    Dim borderweight, bstyle As String, bcolor As String
    borderweight = Switch(Cote.Weight = 1, 1, Cote.Weight = 2, 1, Cote.Weight = -4138, 2, Cote.Weight = 4, 3) & "px  "
    bstyle = IIf(Cote.LineStyle <> 1, "dashed", "solid") 'xlDouble
    If Cote.LineStyle = xlDash And Cote.Weight = xlThick Then borderweight = 3    ' xldash et epaisseur xlthick   'Tiret en pointillet
    If Cote.LineStyle = xlDash And Cote.Weight = xlThin Then borderweight = 2:: bstyle = "dotted"     'point  en pointillet
    If Cote.LineStyle = xlDashDotDot Then borderweight = 3    'xlDashDotDot
    If Cote.LineStyle = xlDouble Then bstyle = " double": borderweight = 3
    bcolor = coul_XL_to_coul_HTMLX(Cote.Color)
    borderstyle = borderweight & bstyle & "  " & bcolor
    If Cote.LineStyle = xlNone Then borderstyle = "0.1pt solid #A9D0F5"
End Function
Function text_BYSPAN_format(c)
'formatage du texte de la cellule html identiquement a la cellule excel
    Dim p As Object, oldspan As Object, i As Long, L, formatcell
    formatcell = c.NumberFormat
    'condition trop simpliste
    'If IsNumeric(c.Value) And c.NumberFormat <> "@" Then text_BYSPAN_format = "&nbsp;" & c.Text: Exit Function
    On Error GoTo direct:    ' on saute la creation pour direct:
    text_BYSPAN_format = ""
    With CreateObject("htmlfile")
        .body.innerhtml = "<div id =T><SPAN> </SPAN></div>"
        Set p = .getelementbyid("T")
        Set oldspan = .getelementsbytagname("SPAN")(0)
        For i = 1 To Len(c.Value)
            Set L = .createelement("span")
            L.Style.Color = coul_XL_to_coul_HTMLX(c.Characters(Start:=i, Length:=1).Font.Color)
           'Round(cel.Font.Size * 1.3) + 2
            L.Style.FontSize = Round(c.Characters(Start:=i, Length:=1).Font.Size * 1.66) & "px"
            L.Style.fontfamily = c.Characters(Start:=i, Length:=1).Font.Name
            L.Style.fontweight = IIf(c.Characters(Start:=i, Length:=1).Font.Bold = True, "Bold", "Normal")
            L.Style.FontStyle = IIf(c.Characters(Start:=i, Length:=1).Font.Italic = True, "italic", "normal")
            If Split(L.outerhtml, ">")(0) <> Split(oldspan.outerhtml, ">")(0) Then
                L.innertext = c.Characters(Start:=i, Length:=1).Text
                p.appendchild (L)
                Set oldspan = L
            Else
                oldspan.innertext = oldspan.innertext & c.Characters(Start:=i, Length:=1).Text
            End If
        Next
        text_BYSPAN_format = "&nbsp;" & .getelementsbytagname("div")(0).innerhtml
    End With
    Exit Function
direct:
    text_BYSPAN_format = "&nbsp;" & c.Text    ' on a sauté la creation on inscrit la valeur
    Err.Clear
    ' ca n'a aucunne incidence puisque tout les formats en dehors de "@" n'accepte qu'une couleur
End Function

[davido84]

Attention car le positionnement du contenu peut changer entre la version Excel à gauche et la version Internet à droite (1/2, 54, 21/12/2016).

Un autre test en intégrant des sauts de ligne dans la feuille Excel (ALT+Enter) :


A+

[patricktoulon]

et oui la on est justement dans ce que je te disais en cas de format horizonalalignement ou verticalalignemnt =null selon le format (texte nombre ,date,etc...) exel applique lui meme ses regles tandis en html il faut le specifier
exemple ici dans ta capture la date en haut a droite si turegarde dans ta barre d'outil texte elle ni a gauche ni a droite ni au milieu c'est adire null tandis que moi j'ai mis left d'office si null dans le html

maintenant on pourrait fair un select case pour tout les format mais bon .....

[patricktoulon]

alors j'ai compris suprime des espaces jusqu'a que le 2 vienne en ligne 1 et remet 1!!!! espace pour qu'il retourne dans sa ligne et fait pareil pour la ligne 3

maintenant lance la conversion

en fait il faut faire un replace des x espace par un br