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.
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.
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 = " " & 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 = " " & .getelementsbytagname("div")(0).innerhtml End With Exit Function direct: text_BYSPAN_format = " " & 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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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+
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 .....
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager