Discussion :

[pijaku]

Je regarderai tout ça en détail demain.

Par curiosité, cette fonction te sers à quoi?

[patricktoulon]

re
elle me sert a remplacer le moulin que j'utilise actuellement

mais ne regarde pas c'est pas bon le dernier il y a des nuances selon le contenu de la cells et ces propriétés

la dernière finale présentée plus haut aussi a un bug
si l'attribut n'existe pas pour fontprop(1)
il faut que j'ajoute un test d'existence de l'attribut ca je sais pas faire

[pijaku]

si l'attribut n'existe pas pour fontprop(1)
il faut que j'ajoute un test d'existence de l'attribut ca je sais pas faire

Simplement
1- avec la propriété Lenght :

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
Public Sub AccessAttributes()
Dim docxml As New MSXML2.DOMDocument    'Nouveau doc Xml
Dim Noeud As IXMLDOMNode                'Node
Dim Attributs As IXMLDOMNamedNodeMap    'Collection
Dim A As IXMLDOMAttribute               'Pour boucler sur la collection
 
    With docxml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Noeud = .SelectSingleNode("/Workbook/Styles/Style/Protection")
        If Not Noeud Is Nothing Then
            Set Attributs = Noeud.Attributes
            If Attributs.Length > 0 Then
                For Each A In Attributs
                    Debug.Print A.BaseName & " := " & A.Value
                Next
            End If
        End If
    End With
End Sub

2- avec un Boolean, comme ceci par exemple :

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
Option Explicit
 
Public Sub AccessAttributes()
Dim docxml As New MSXML2.DOMDocument    'Nouveau doc Xml
Dim Noeud As IXMLDOMNode                'Node
Dim Attributs As IXMLDOMNamedNodeMap    'Collection
Dim A As IXMLDOMAttribute               'Pour boucler sur la collection
Dim AttributsExists As Boolean
 
    With docxml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Noeud = .SelectSingleNode("/Workbook/Styles/Style/Protection")
        If Not Noeud Is Nothing Then
            Set Attributs = Noeud.Attributes
                For Each A In Attributs
                    AttributsExists = True
                    Debug.Print A.BaseName & " := " & A.Value
                Next
                If Not AttributsExists Then MsgBox "pas d'attributs"
        End If
    End With
End Sub

[patricktoulon]

oui on retombe donc dans une boucle
je pensais a une chose du genre comme en html

Code :

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

element.getAttribute("ss:xxxxxxxxx")

[pijaku]

Bonjour,

Non pas de boucle.

Bon, j'ai repris ta fonction plus haut et l'ai corrigée et commentée (lis bien les commentaires).
Il te reste à modifier comme tu l'entends.

Rappel : getAttribute est une méthodse de IXMLDOMElement pas de IXMLDOMNode.

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
Option Explicit
 
Sub test()
    Dim cel As Range
    Dim doc As Object
    Set doc = CreateObject("htmlfile")
    'creation de la table dans le doc en DOM
    'blablabla
    Set cel = Sheets(1).Range("A17")
    Debug.Print htmltexte(cel, doc)
End Sub
 
Public Function htmltexte(cel, doc)
Dim docxml As New MSXML2.DOMDocument        'Nouveau doc Xml
Dim fontprop As MSXML2.IXMLDOMNodeList      'Liste des Noeuds "Font"
'La méthode getAttribute ne fonctionnant pas sur un Noeud, mais sur un Element :
Dim Elements(1) As MSXML2.IXMLDOMElement    'Tableau d'Elements pour stocker la liste des Noeuds "Font"
Dim innerH As MSXML2.IXMLDOMNode            'Noeud "Data"
Dim objFontSize As MSXML2.IXMLDOMAttribute  'Objet Attribute pour le Font_Size
Dim i&, ppx#, Fonts As Object, Font_Name$, Font_Size$, Font_Color$, innerhtmls$
 
    With docxml
        With CreateObject("WScript.Shell")
            ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
        End With
        If Not .LoadXML(cel.Value(xlRangeValueXMLSpreadsheet)) Then
            Err.Raise .parseError.ErrorCode, , .parseError.reason
        End If
        'recherche des propriétés font
        Set fontprop = .getElementsByTagName("Font")
        'Transfert des DOMNode dans des DOMElement
        For i = 0 To fontprop.Length - 1
            Set Elements(i) = fontprop(i)
        Next
        i = fontprop.Length - 1
        'font name + font size + font color
        Font_Name = Elements(i).getAttribute("ss:FontName")
        Font_Color = Elements(i).getAttribute("ss:Color")
        'Pour le cas ou tu as diminué la taille de police de la cellule,
        'sans que cela ne change la hauteur de la ligne,
        'ça plante car il n'y a pas d'attribut Size.
        Set objFontSize = Elements(i).getAttributeNode("ss:Size") 'ici on retourne l'objet Attribute "Size" pour tester s'il existe
        If Not objFontSize Is Nothing Then
            Font_Size = objFontSize.Value
        Else
            Font_Size = Elements(0).getAttribute("ss:Size")
        End If
        'innerhtml
        If IsDate(cel.Value) Then
            innerhtmls = cel.Text 'si c'est une date elle sera affichée a l'identique qu'Excel
        Else    'sinon
            Set innerH = .SelectSingleNode("/Workbook/Worksheet/Table/Row/Cell/Data")
            'si pas de donnée dans la cellule ==> pas de balise Data
            If Not innerH Is Nothing Then
                innerhtmls = Split(innerH.XML, Split(innerH.XML, ">")(0) & ">")(1)
                innerhtmls = Split(Replace(Replace(innerhtmls, "xmlns:html=""http://www.w3.org/TR/REC-html40""", ""), "html:", ""), "</Data")(0)
            Else
                'Ici, pas de donnée donc innerhtmls = ""
            End If
        End If
    End With
    'à partir d'ici je crois que tu as changé de méthode, à adapter donc...
    With doc.createelement("FONT")
        .face = Font_Name
        .Style.Color = Font_Color
        .Style.FontSize = Font_Size * ppx
        .innerhtml = Replace(innerhtmls, "xmlns:x=""urn:schemas-microsoft-com:office:excel", "")
        'correction des font-size dans le font global
        Set Fonts = .getElementsByTagName("FONT")
        For i = 0 To Fonts.Length - 1
            If Fonts(i).Size <> "" Then
                Fonts(i).Style.FontSize = Fonts(i).Size * ppx
                Fonts(i).Size = ""
            End If
        Next
        htmltexte = .outerhtml
    End With
 
    Erase Elements
    Set docxml = Nothing
    Set fontprop = Nothing 
    Set innerH = Nothing
    Set objFontSize = Nothing
    Set Fonts = Nothing
End Function

[pijaku]

Je penses que tu devrais ouvrir une nouvelle discussion intitulée : Création d'un document html à partir du fichier xml d'une plage.
Ici nous dévions de plus en plus et le nombre de pages risque fort de devenir illisible.

J'ai également quelque chose à te montrer sur la future discussion.
Le projet est de ne plus regarder cellule par cellule...
Mais, je ne sais toujours pas à quoi cela te sers...

A créer des pages d'un site Internet? Autre?

A te lire.

[Invité]

Bonjour,

je ne sais as ou ça peut mener! à voir!

http://www.uoh.fr/front/document/b78...UOH/co/25.html

[patricktoulon]

re
Bonjour Robert
merci pour le lien
j'ai pas tres bien compris mais on buchera

en attendant grosse déception pour ma part

je me suis engagé dans cet exercice croyant moins mouliner avec mes fonction excel to html puisque tout est dans le xml mais c'est largement plus lourd et plus long

le résultats reste nickel

voila le code au complet
si vous avez des idées pour accélère la cadence

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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
 
Option Explicit
Sub testf()
    Dim plage As Range, IE As Object
    Set plage = Sheets(1).Range("A1:d5")
    'Debug.Print Grille_To_Html_Base(plage, True)
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True
    IE.navigate "about:blank"
    IE.document.write Grille_To_Html_Base2(plage, True, True)
End Sub
Function Grille_To_Html_Base2(plage, Optional interior_style As Boolean = False, Optional border_style As Boolean = False)
    Dim ppx, doc As Object, TR, TD, TABLO, i#, col#, cel, aligne, valigne
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    Set doc = CreateObject("htmlfile")
    With doc
        .body.innerhtml = "<table><TBODY></TBODY></table>"
        With .getElementsByTagName("TABLE")(0): .Style.Width = plage.Width * ppx:
            .Style.Color = "#000000": .Style.fontfamily = ThisWorkbook.Styles("Normal").Font.Name:
            .setattribute ("range:" & plage.Address)
            .Style.bordercollapse = "collapse":
            .cellspacing = 0
        End With
        Set TABLO = .getElementsByTagName("TBODY")(0)
        For i = 1 To plage.Rows.Count
            Set TR = .createelement("TR")
            TABLO.appendchild (TR)
            For col = 1 To plage.Columns.Count
                Set cel = plage.Cells(i, col)
                If .getElementById(Replace(cel.MergeArea.Address, "$", "")) Is Nothing Then
                    Set TD = .createelement("TD")
                    TD.ID = Replace(cel.MergeArea.Address, "$", "")
                    TD.colspan = Range(TD.ID).Columns.Count: TD.rowspan = Range(TD.ID).Rows.Count
                    TD.Style.Width = cel.MergeArea.Width * ppx
                    TD.Style.Height = cel.MergeArea.Height * ppx
                    TD.Style.Border = "1px solid #A9BCF5"
                    TD.Style.verticalAlign = alignementV(cel)
                    TD.Style.textAlign = alignementh(cel)
                    If border_style = True Then
                        TD.Style.bordertop = bordure2(cel, "Top")
                        TD.Style.borderleft = bordure2(cel, "Left")
                        TD.Style.borderright = bordure2(cel, "Right")
                        TD.Style.borderbottom = bordure2(cel, "Bottom")
 
                    End If
                    If interior_style = True Then
                        If cel.Value <> "" Then TD.innerhtml = htmltexte(cel, doc)
                        TD.Style.backgroundcolor = interiorcolor(cel)
                    Else
                        TD.innertext = cel.Text
                    End If
                    'Debug.Print TD.Children.Length
                    If TD.Children.Length > 0 Then TD.ChildNodes(0).Style.MarginLeft = 3 & "px"
                    TR.appendchild (TD)
                End If
            Next
        Next
        Grille_To_Html_Base2 = .body.innerhtml
    End With
End Function
Function bordure2(cel, coté) As String
    Dim b, bd$, bdWeight$
    bd = "1px solid #A9BCF5"
    b = Split(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Position=""" & coté)
    If UBound(b) > 0 Then
        bd = Replace(Replace(Replace(Split(b(1), "/")(0), "Dash", "Dashed "), "Continuous", "Solid "), "Dot", "Dotted ")
        b = Split(bd, "=""")
        bdWeight = IIf(Split(b(1), Chr(34))(0) = "Dotted ", 2, Split(b(2), Chr(34))(0))
        bd = bdWeight & "px " & Split(b(1), Chr(34))(0) & " " & Split(b(3), Chr(34))(0)
    End If
    bordure2 = bd
End Function
Function interiorcolor(cel)
    Dim EXTRAITXML, A
    EXTRAITXML = cel.Value(xlRangeValueXMLSpreadsheet)
    A = Split(EXTRAITXML, "<Interior ss:Color=""")
    If UBound(A) > 0 Then interiorcolor = Split(Split(EXTRAITXML, "<Interior ss:Color=""")(1), Chr(34))(0)
End Function
Function alignementh(cel)
    Dim EXTRAITXML, A
    EXTRAITXML = cel.Value(xlRangeValueXMLSpreadsheet)
    A = Split(EXTRAITXML, "ss:Horizontal=""")
    If UBound(A) > 0 Then
        A = Trim(Split(A(UBound(A)), Chr(34))(0))
    Else
        A = IIf(IsDate(cel.Text) Or IsNumeric(cel.Value), "right", "left")
    End If
    alignementh = A
End Function
Function alignementV(cel)
    Dim EXTRAITXML, Av, A
    EXTRAITXML = cel.Value(xlRangeValueXMLSpreadsheet)
    A = Split(EXTRAITXML, "ss:Vertical=""")
    If UBound(A) > 0 Then
        Av = Replace(Trim(Split(A(UBound(A)), Chr(34))(0)), "center", "middle")
    Else
        Av = "bottom"
    End If
    alignementV = Av
End Function
Public Function htmltexte(cel, doc)
    Dim docxml As New MSXML2.DOMDocument    'Nouveau doc Xml
    Dim fontprop As Object, InnerH, i#, ppx, Fonts As Object, Font_name$, Font_size$, Font_Color$, FI$, FU$, FS$, FB$, InnerHtmls$
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    With docxml
        If Not .LoadXML(Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason
        'recherche des propriétés font
        Set fontprop = .getElementsByTagName("Font")
        Font_name = fontprop(0).getAttribute("ss:FontName")    'par defaut
        Font_size = fontprop(0).getAttribute("ss:Size")    'par defaut
        Font_Color = fontprop(0).getAttribute("ss:Color")    'par defaut
        If fontprop.Length > 1 Then
            Font_name = fontprop(1).getAttribute("ss:FontName")  'le font name 2
            Font_size = fontprop(1).getAttribute("ss:Size")            'le font size 2
            'fontcolor
            If Not IsNull(cel.Font.Color) And cel.Font.Color > 0 Then Font_Color = fontprop(1).getAttribute("ss:Color")
        End If
        'le font bold global
        FB = IIf(cel.Font.Bold, "<B>", "")
        'le font italic global
        FI = IIf(cel.Font.Italic, "<EM>", "")
        'le underline
        FU = IIf(cel.Font.Underline > 0, "<U>", "")
        'le font strikehout
        FS = IIf(cel.Font.Strikethrough, "<S>", "")
        'innerhtml
        Set InnerH = docxml.SelectSingleNode("/Workbook/Worksheet/Table/Row/Cell/Data")
        InnerHtmls = Split(InnerH.XML, Split(InnerH.XML, ">")(0) & ">")(1)
        InnerHtmls = Split(Replace(Replace(InnerHtmls, "xmlns:html=""http://www.w3.org/TR/REC-html40""", ""), "html:", ""), "</Data")(0)
        If IsDate(cel.Value) Then InnerHtmls = cel.Text
        If Not InnerHtmls Like "*Font*" Then InnerHtmls = FB & FI & FU & FS & InnerHtmls & Replace(FS & FU & FI & FB, "<", "</")
        With doc.createelement("FONT")
            .face = Font_name: .Style.Color = Font_Color: .Style.FontSize = Font_size * ppx
            .innerhtml = Replace(InnerHtmls, "xmlns:x=""urn:schemas-microsoft-com:office:excel", "")
            'correction des font-sise dans le font global
            Set Fonts = .getElementsByTagName("FONT")
            For i = 0 To Fonts.Length - 1
                If Fonts(i).Size <> "" Then Fonts(i).Style.FontSize = Fonts(i).Size * ppx: Fonts(i).Size = ""
            Next
            htmltexte = .outerhtml
        End With
    End With
    Set docxml = Nothing: Set fontprop = Nothing: Set InnerH = Nothing
End Function

[pijaku]

Patrick,

Peux tu me répondre clairement stp?
C'est pour faire quoi exactement?
Et ne me parle pas DOM, html etc, je n'y comprends rien.

Par contre, si tu es intéressé par un code ultra-rapide qui te transforme le style de ta plage en une feuille de style css, j'ai un très bon début de piste.
Avant de te le livrer, j'attends ta réponse.

[patricktoulon]

bonjour pijaku
pour faire quoi?
et bien j'ai plein de petite app dans des fichiers excel plus ou moins lourdes

je les transforme en fichier.HTA (application html)a la volé
pour cela je créé le document en html puis le sauve dans un fichier hta

j'ajoute les fonctions qui sont dans les cellules Excel transformée en JavaScript ( je le code a la main dans le document html(bloknote/noptpâd+))
j'ai ainsi un fichier fonctionnant quasiment comme Excel et facilement transportable sans Excel et LLLLLLLLLargement !!!!!!!plus rapide
on observe bien la différence entre le fixe et le pc portable

j'espère avoir répondu a ta question

[pijaku]

Oui, tu as bien répondu.
Je n'ai rien compris , mais ça vient de moi, je ne connais pas ce dont tu parles.

Voici un début de piste alors.
Il reste à faire :

1. les borders-line : je ne connais pas assez le css pour les faire (Sub AddStyleToCss),
2. j'ai un doute sur l'alignement vertical d'un texte en css. Dans le doute, j'ai mis vAlign (Sub AddStyleToCss),
3. le code pour créer le html (Sub CreateHtml) à partir de /Workbook/Worksheet/Table : mais je crois que tu l'as...

Il faut adapter les deux constantes en entête de module :

1. DEFAULTFONT : si tu as besoin d'une police en plus dans le css (sinon mettre "")
2. REP : le répertoire de sauvegarde du fichier feuille de style css

Adapte aussi la plage à traiter dans la Sub Test()...

J'ai mis des "#" pour que tu puisses, dans le html, récupérer le style par l'id.
Tu peux, si tu veux le récupérer par une classe, changer "#" en "."...

L'élément html Table doit avoir l'id "#Default", les autres éléments, les id sont identique.
Exemples :

#Default {
vAlign: Bottom;
font-family: Calibri, Times New Roman;
font-size: 11px;
font-color: #000000;
}
#s62 {
}
#s64 {
border-Bottom: 1px ;
border-Left: 1px ;
border-Right: 1px ;
border-Top: 1px ;
}

Pour info, avec une plage A2:AD61 et 48 styles différents, le code est exécuté en 0,125 secondes sur mon petit pc.

Le code :

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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Option Explicit
 
Private Css() As String, Cpt As Long
 
'**********----------**********----------** *** **----------**********--------
Private Const DEFAULTFONT As String = "Times New Roman"             'A ADAPTER
Private Const REP As String = "C:\Users\pijaku\Desktop\"     'A ADAPTER
'**********----------**********----------** *** **----------**********--------
 
Public Sub Test()
Dim MyXml As New MSXML2.DOMDocument
Dim num As Long, i As Long
Dim t As Single
 
    t = Timer
    Call Initialise(MyXml, Range("A2:AD61"))
 
    num = FreeFile
    Open REP & "Test.css" For Output As #num
        For i = LBound(Css) To UBound(Css)
            Print #1, Css(i)
        Next i
    Close #num
    Erase Css
    MsgBox Timer - t
End Sub
 
Private Sub Initialise(docxml As MSXML2.DOMDocument, Plage As Range)
Dim Noeud As IXMLDOMNode, Tabl As IXMLDOMNode
 
    With docxml
        If Not .LoadXML(Plage.Value(xlRangeValueXMLSpreadsheet)) Then
            Err.Raise .parseError.ErrorCode, , .parseError.reason
        End If
        'Debug.Print .XML
        Cpt = -1
        Set Noeud = .SelectSingleNode("/Workbook/Styles")
        Call CreateCss(Noeud)
        Set Noeud = .SelectSingleNode("/Workbook/Worksheet/Table")
        Call CreateHtml(Noeud)
    End With
    Set Noeud = Nothing
    Set Tabl = Nothing
    Set docxml = Nothing
End Sub
 
'**********----------**********----------** CSS **----------**********----------**********
Private Sub CreateCss(Styles As MSXML2.IXMLDOMNode)
Dim Noeuds As MSXML2.IXMLDOMNodeList, SubNoeuds As MSXML2.IXMLDOMNodeList
Dim Balise As IXMLDOMNode
Dim Element As IXMLDOMElement
Dim i As Long
 
    Set Noeuds = Styles.SelectNodes("Style")
    For i = 0 To Noeuds.Length - 1
        Set Element = Noeuds(i)
        Cpt = Cpt + 1
        ReDim Preserve Css(Cpt)
        Css(Cpt) = "#" & Element.getAttribute("ss:ID") & " {"
        Set SubNoeuds = Noeuds(i).ChildNodes
        For Each Balise In SubNoeuds
            Select Case Balise.BaseName
                Case "Borders": Call AddBordersStyleToCss(Balise)
                Case "Alignment", "Font", "Interior": Call AddStyleToCss(Balise)
            End Select
        Next
        Cpt = Cpt + 1
        ReDim Preserve Css(Cpt)
        Css(Cpt) = "}"
    Next
    Set Noeuds = Nothing
    Set Element = Nothing
    Set SubNoeuds = Nothing
    Set Balise = Nothing
End Sub
 
Private Sub AddBordersStyleToCss(Baliz As IXMLDOMNode)
Dim SubNoeuds As MSXML2.IXMLDOMNode
'cas particulier des bordures : le noeud <Borders> contient des SubNodes <Border>
    For Each SubNoeuds In Baliz.ChildNodes
        Call AddStyleToCss(SubNoeuds)
    Next
    Set SubNoeuds = Nothing
End Sub
 
Private Sub AddStyleToCss(Baliz As IXMLDOMNode)
'Sub de conversion xml en css : code pourri, mais fonctionnel
Dim Attribut As IXMLDOMAttribute, Nom As String, Valeur As String
Dim Element As IXMLDOMElement, ValLine As String, ValWeight As String, ValColor As String
 
    For Each Attribut In Baliz.Attributes
        Nom = vbNullString
        Select Case Baliz.BaseName
            Case "Border"
                If Attribut.BaseName = "Position" Then
                    Set Element = Baliz
                    ValLine = "" 'Element.getAttribute("ss:LineStyle") '        RESTE A FAIRE
                    ValWeight = Element.getAttribute("ss:Weight") & "px"
                    If Baliz.Attributes.Length > 3 Then ValColor = Element.getAttribute("ss:Color")
                    Nom = "border-" & Attribut.Value
                    Valeur = ValLine & " " & ValWeight & " " & ValColor
                End If
 
            Case "Alignment"
                Valeur = Attribut.Value
                If Baliz.Attributes.Length = 1 Then
                    Nom = "vAlign"
                ElseIf Baliz.Attributes.Length = 2 Then
                    Nom = IIf(Attribut.BaseName = "Horizontal", "text-align", "vAlign")
                End If
 
            Case "Font"
                Select Case Attribut.BaseName
                    Case "FontName": Nom = "font-family": Valeur = Attribut.Value & ", " & DEFAULTFONT
                    Case "Size": Nom = "font-size": Valeur = Attribut.Value & "px"
                    Case "Color": Nom = "font-color": Valeur = Attribut.Value
                    Case "Bold": Nom = "font-weight": Valeur = "Bold"
                    Case "Italic": Nom = "font-style": Valeur = "italic"
                    Case "Underline": Nom = "text-decoration": Valeur = "underline"
                End Select
 
            Case "Interior"
                If Attribut.BaseName = "Color" Then Nom = "color": Valeur = Attribut.Value
        End Select
        If Nom <> vbNullString Then
            Cpt = Cpt + 1
            ReDim Preserve Css(Cpt)
            Css(Cpt) = Nom & ": " & Valeur & ";"
        End If
    Next
End Sub
 
'**********----------**********----------** HTML **----------**********----------**********
Private Sub CreateHtml(Table As MSXML2.IXMLDOMNode)
    'vérifier préalablement si Plage.Cells(1, 1) possède une valeur ou un style
 
End Sub

EDIT : souci d'interprétation de Border.Weight ==> à faire également alors...

[patricktoulon]

re
oui j'y avais pensé a le faire comme ca puisque la structure est quasi faite

sauf que

1 il n'y a pas toutes les ID de cellule dans le style (c'est normal certaine n'ont aucun style(all Automatique)
2 ces id sont générée dynamiquement et pour les faire correspondre aux cellules crées html dur dur
c'est pour cela que le le fait une par une
valign c'était une variable c'est verticalalign la propriété css equivalenta verticalalignment de excel

c'est pour cela que plus haut dans la discussion j'avais dit "il serait interessant de trouver comment les ids sont créés" ca me permettrai effectivement de créer comme tu le fait une feuille de style css globale

pour cela j'avais eu une idée
faire comme tu le fait ta feuille de style globale

et boucler comme je le fait sur chaque cellule sauf que c'est juste pour recuperer le id de la cell

malheureusement si tu lance x fois

Code :

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

debug.print lamemecellule.value(xlRangeValueXMLSpreadsheet)

tu aura une id différente a chaque fois c'est ballo

[pijaku]

Non Patrick.
L'id du Style dans le fichier xml, balise <Styles> correspond à l'id de la Cell que tu trouves dans le fichier xml, balise <Table>.

C'est pour ça que je fais comme ceci...

Un exemple de tout petit fichier xml.
J'ai juste modifié deux cellules :

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
<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:o="urn:schemas-microsoft-com:office:office"
 xmlns:x="urn:schemas-microsoft-com:office:excel"
 xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:html="http://www.w3.org/TR/REC-html40">
 <Styles>
  <Style ss:ID="Default" ss:Name="Normal">
   <Alignment ss:Vertical="Bottom"/>
   <Borders/>
   <Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#000000"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
  <Style ss:ID="s62">
   <Interior ss:Color="#FFFF00" ss:Pattern="Solid"/>
  </Style>
  <Style ss:ID="s64">
   <Interior ss:Color="#0070C0" ss:Pattern="Solid"/>
  </Style>
 </Styles>
 <Worksheet ss:Name="Feuil1">
  <Table ss:ExpandedColumnCount="2" ss:ExpandedRowCount="2"
   ss:DefaultColumnWidth="60" ss:DefaultRowHeight="15">
   <Row>
    <Cell ss:Index="2" ss:StyleID="s62"/>
   </Row>
   <Row>
    <Cell ss:StyleID="s64"><Data ss:Type="Number">321</Data></Cell>
   </Row>
  </Table>
 </Worksheet>
</Workbook>

Je retrouve bien mon Cell ss:StyleID="s64" dans la Table qui correspond à mon Style ss:ID="s64" des Styles.

Après, pour les cellules génériques, il te suffit de code ton html comme ceci :

Code :

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

1
2
3
4
5
6
7
<Table id="Default">
    <Tr>
        <td id="s64">321</td>
        <td id="s62"></td>
        <td>poireau</td> <!-- prendra le style Default -->
    </tr>
</Table>

[patricktoulon]

oui avec 2 cellules !!!

fait moi plaisir teste sur une plage de x lignes sur x colonnes avec des cellules vides et/ou sans style
tu va comprendre ce que je veux dire

quand tu appelle "call createhtml" tu n'a aucun !!!! repère pour placer ta cellule dans la tablehtml en terme de ligne ou colonne aucun !!!

j'ai tourné cela dans tout les sens avant que tu fasse ta proposition

[patricktoulon]

oulah mille excuse tu a peut etre raison
en effet

mais ca va ettre cottion a codé le html

boucle sur les "<row" puis sur cells et reperer le "index=" qui te donne l'index sur sa ligne puis data en ne gardant que les id

bien vu
je regarde ca

merci pijaku

[pijaku]

Après il faut te repérer entre lignes et colonnes.
Pour cela voir ma réponse 34 ici #post9612638

Et donc, trouver un moyen de déterminer la première cellule de la plage...

[patricktoulon]

non c'est bon tu avais absolument raison j'ai testé avec un simple split ca match

c'est moins propre et moins pro que tes exemple mais bon contrairement au fait que je métrise le html dynamique en DOM ou en string je métrise mal l'object xmldom

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
Sub testglob()
    Dim plage As Range
    Set plage = Range("A1:D5")
    'Debug.Print plage.Value(xlRangeValueXMLSpreadsheet)
    Debug.Print createhtml(plage)
End Sub
Function createhtml(plage As Range)
    Dim TD, TR, DOC, Tablo, ROW, CTD, L, COL, idd
    Set DOC = CreateObject("htmlfile")
    DOC.body.innerhtml = "<TABLE><TBODY></TBODY></TABLE>"
    Set Tablo = DOC.getElementsByTagName("TBODY")(0)
    ROW = Split(plage.Value(xlRangeValueXMLSpreadsheet), "<Row")
    For L = 1 To UBound(ROW)
        Set TR = DOC.createelement("TR")
        Tablo.appendchild (TR)
        CTD = Split(ROW(L), "<Cell")
        For COL = 1 To UBound(CTD)
            Set TD = DOC.createelement("TD")
            idd = Split(CTD(COL), "StyleID=""")
            If UBound(idd) > 0 Then TD.iD = Split(idd(1), Chr(34))(0) & """"
            TR.appendchild (TD)
        Next
    Next
    createhtml = DOC.body.innerhtml
End Function

resultat

<TABLE>
<TBODY>
<TR>
<TD id=s83></TD>
<TD id=s91></TD>
<TD id=s74></TD>
<TD></TD></TR>
<TR>
<TD></TD>
<TD id=s66></TD>
<TD id=s76></TD></TR>
<TR>
<TD id=s94></TD>
<TD id=m7084448></TD>
<TD id=s69></TD></TR>
<TR>
<TD id=s85></TD>
<TD id=s68></TD></TR>
<TR>
<TD id=s93></TD>
<TD id=s67></TD>
<TD></TD>
<TD></TD></TR></TBODY></TABLE>

[pijaku]

En même temps, dans mes fonctions il y a quand même deux-trois trucs à revoir...
Si j'ai le temps, je fignolerai plus tard.

L'important est que tu disposes d'une bonne base.

Sujet résolu?

[Invité]

Dans l'xml que j'ai regardé,il n'y a pas autant de style que de Celulle !

Code :

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

1
2
style="<style>.StyleID68{font-color: #000000;}</style>"
Hmbody="<td class='StyleID68'></td>

[pijaku]

Normal.
Les cellules vides et "sans style" doivent être affectées de l'id "Default".