Discussion :

[Invité]

Bonjour,

[pijaku]

@Robert :


@Patrick :
Peut-être as tu recherché l'attribut "FontName" au lieu de "ss:FontName"...

J'ai fait une contribution (encore incomplète, mais qui attends vos désidératas) à ce sujet : ==ICI==

[patricktoulon]

a bon je croyais que c'était moi mais non
voila pijaku ce que je voulais expliquer
sans boucle en utilisant les index de la collection ca matche pas

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
Option Explicit
 
Public Sub test()
Dim docxml As New MSXML2.DOMDocument    'Nouveau doc Xml
Dim Noeuds As IXMLDOMNodeList           'Liste de noeuds de docxml
Dim E As IXMLDOMElement                 'Elément
Dim vIn As String                       'A chercher
Dim vOut As String                      'Valeur de retour
Dim i#
    With docxml
        If Not .LoadXML(Replace(Range("a1").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason
        'recherche tous les noeuds appelés font
        Set Noeuds = .getElementsByTagName("Font")
        'Nom de l'attribut à chercher
        vIn = "ss:FontName"
 
            Debug.Print Noeuds(0).XML' c'est bon il est bien identifié 
            Debug.Print Noeuds(1).XML' c'est bon il est bien identifié
            Debug.Print Noeuds(0).getAttribute(vIn)' et toc!!!! ca matche pas 
 
 
 
    End With
    Set docxml = Nothing
    Set Noeuds = Nothing
End Sub

je répète donc ma question plus précisément
est il possible de récupérer l'attribut d'un élément sans boucler sur la collection d'élément du même tag

car pijaku dans ton exemple ca marche

mais si j'ai plus de 1 couleur dans la cellule ou une partie bold et tout simplement 2 partie de texte diffèrent il y a le code html de la valeur de cellule dans le tag DATA donc plus de 2 tag "font" dans le xml

les fonts qui sont dans le data n'ont pas d'attribut "fontname" mais "face" (c'est encodé en HTML)

je donne une exemple de xml

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
<?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="m45881984">
            <Alignment ss:Horizontal="Center" ss:Vertical="Center" ss:WrapText="1"/>
            <Borders>
                <Border ss:Position="Bottom" ss:LineStyle="Dot" ss:Weight="1" ss:Color="#FF0000"/>
                <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="3" ss:Color="#FF0000"/>
            </Borders>
            <Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#00FFFF"/>
            <Interior ss:Color="#FAC090" ss:Pattern="Solid"/>
        </Style>
    </Styles>
    <Worksheet ss:Name="Feuil1">
        <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:DefaultColumnWidth="62.400000000000006" ss:DefaultRowHeight="14.4">
            <Column ss:AutoFitWidth="0" ss:Width="95.399999999999991"/>
            <Row ss:AutoFitHeight="0" ss:Height="25.2">
                <Cell ss:StyleID="m45881984"><ss:Data ss:Type="String" xmlns="http://www.w3.org/TR/REC-html40">g<B>g</B><Font html:Color="#00FFFF">gttt</Font><Font html:Color="#FF0000">t</Font><Font html:Face="Algerian" x:Family="Decorative" html:Color="#FF0000">tt</Font><Font html:Color="#FF0000">tt</Font><Font html:Color="#00FFFF">t</Font><B><Font html:Color="#00FFFF">g</Font><I><Font html:Size="16" html:Color="#00FFFF">gg</Font></I><Font html:Size="16" html:Color="#00FFFF">g</Font></B><Font html:Color="#00FFFF">gggg gggggggggghhhhhhhhhhhhhh</Font></ss:Data></Cell>
            </Row>
        </Table>
    </Worksheet>
</Workbook>

bref je veux que les font qui ne sont pas dans le DATA donc le (0) et le (1)

[patricktoulon]

re
en fait ca fonctionne comme ca

Code :

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

1
2
3
4
5
6
7
8
 'recherche tous les noeuds appelés font
        Set Noeuds = .getElementsByTagName("Font")
        'Nom de l'attribut à chercher
        vIn = "ss:FontName"
        Set n = Noeuds(0)
        Debug.Print n.getAttribute(vIn)
        Set n2 = Noeuds(1)
        Debug.Print n2.getAttribute(vIn)

va savoir pourquoi "nœuds(0/1)" n'est pas un xmlelement dans un debug.print direct

[pijaku]

Le principe :
1- on cible le parent des font que tu cherches, ici Style grâce à : .SelectSingleNode("/Workbook/Styles/Style")
2- on récupère tous les noeuds enfant de ce Noeud "cible" se nommant "Font", grâce à : .SelectNodes("Font")
3- on boucle sur la collection des noeuds Font ayant comme parent Style
4- On récupère les attributs grâce à la collection Attributes
5- on boucle sur les attributs et on récupère leur nom et leur valeur (grâce à getAttribute)

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
Option Explicit
 
Public Sub AccessNode()
Dim MyXml As New MSXML2.DOMDocument
Dim Noeuds As IXMLDOMNodeList
Dim NoeudCible As IXMLDOMNode
Dim Noeud As IXMLDOMElement
Dim Attributs As IXMLDOMNamedNodeMap    'Collection
Dim A As IXMLDOMAttribute               'Pour boucler sur la collection
Dim vOut As String
 
    With MyXml
        If Not .LoadXML(Replace(Range("a1").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then Err.Raise .parseError.ErrorCode, , .parseError.reason
        'accès au Noeud :
            '<Workbook>
                '<Styles>
                    '<Style>
        Set NoeudCible = .SelectSingleNode("/Workbook/Styles/Style")
        If Not NoeudCible Is Nothing Then
            Set Noeuds = NoeudCible.SelectNodes("Font")
            For Each Noeud In Noeuds
                Set Attributs = Noeud.Attributes
                For Each A In Attributs
                    vOut = Noeud.getAttribute(A.Name)
                    Debug.Print A.Name & "  " & vOut
                Next
            Next
        End If
    End With
    Set NoeudCible = Nothing
    Set Attributs = Nothing
    Set Noeud = Nothing
    Set MyXml = Nothing
End Sub

[pijaku]

va savoir pourquoi "nœuds(0/1)" n'est pas un xmlelement dans un debug.print direct

Si tu déclares Noeuds As IXMLDOMNodeList, et que tu boucles sur cette collection grâce aux Items (Noeuds(0), Noeuds(1), etc...), les éléments de cette collection seront du type IXMLDOMNode.
Or, il s'avère que (la consultation de l'explorateur d'objet le confirme), l'objet IXMLDOMNode n'a pas la méthode getAttributes.
Par contre, l'objet IXMLDOMElement lui, la possède.

Donc, il suffit de boucler sur la Collection IXMLDOMNodeList, non pas par les Items, mais grâce à une variable IXMLDOMElement.
Tout simplement.

[patricktoulon]

re
je pense que j'ai trouver bonheur

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
Option Explicit
Public Sub test()
    Dim docxml As New MSXML2.DOMDocument    'Nouveau doc Xml
    Dim Noeuds As Object, innerH, cel As Range    'Liste de noeuds de docxml
    Dim Font_Name$, Font_Size$, Font_Color$, innerhtmls$
    Set cel = Sheets(1).Range("B3")
    With docxml
        If Not .LoadXML(Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason
        'recherche tous les noeuds appelés font
        Set Noeuds = .getElementsByTagName("Font")
        'le font name
        Font_Name = Noeuds(0).getAttribute("ss:FontName")
        Font_Name = Noeuds(1).getAttribute("ss:FontName")
        'le font size
        Font_Size = Noeuds(0).getAttribute("ss:Size")
        Font_Size = Noeuds(1).getAttribute("ss:Size")
        'le font color
        Font_Color = Noeuds(1).getAttribute("ss:Color")    'on prends le 2 automatiquement
        ' si il y a des font dans la valeur de data alors on prends le 1
        If IsNull(cel.Font.Color) Then Font_Color = Noeuds(0).getAttribute("ss:Color")
        Debug.Print "propriété Globale du texte de la cellule : " & vbCrLf & Font_Name & " " & Font_Size & " " & Font_Color
        Debug.Print " "
        'la valeur de la cellule
        Set innerH = docxml.SelectSingleNode("/Workbook/Worksheet/Table/Row/Cell/Data")
        'la cellule au format text
        Debug.Print "la cellule au format text : " & vbCrLf & innerH.Text
        Debug.Print " "
        ' la cellule au format  HTML : "
        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)
        Debug.Print "la cellule au format HTML : " & vbCrLf & innerhtmls
    End With
    Set docxml = Nothing
    Set Noeuds = Nothing
End Sub

merci pijaku

si il y a moyen de prendre le InnerHTML plus proprement je prends

si tu comprends pas pourquoi je réinitialise les variables font_name et font_size 2 fois tu n'a qua regarder le font_color tu devinera pourquoi
ou en testant une cellule tout en rouge par exemple ou une cellule avec une/des parties différentes du reste du texte dans une cellule en terme de format

[pijaku]

si il y a moyen de prendre le InnerHTML plus proprement je prends

Tu remplis (valeur et format) ta cellule comment?
Ok, j'ai vu...
je regarde.

[patricktoulon]

Ben oui en fait il y a plusieurs possibilités et cela en fonction de l'extraiXml retourné

si tu a une cellule avec le texte tout de la même couleur le innerhtml et pareil que le innertext et les couleur sont a prendre dans le 2 d font name

si ta cellule contient un texte de plusieurs couleur le innerhtml est au format html donc si le/les premier(s) caractère(s) sont noirs et un font name normal alors il faut ajouter un font global dans le innerhtml

et ce font sera au format des attributs récupérés dans les fonts (0/1) qui sont des balises style

ca a l'air compliqué mais pas du tout le html je métrise plutôt bien

exemple


xml retourné

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
<?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="m45881984">
            <Alignment ss:Horizontal="Center" ss:Vertical="Center" ss:WrapText="1"/>
            <Borders>
                <Border ss:Position="Bottom" ss:LineStyle="Dot" ss:Weight="1" ss:Color="#FF0000"/>
                <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="3" ss:Color="#FF0000"/>
            </Borders>
            <Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#00FFFF"/>
            <Interior ss:Color="#FAC090" ss:Pattern="Solid"/>
        </Style>
    </Styles>
    <Worksheet ss:Name="Feuil1">
        <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:DefaultColumnWidth="62.400000000000006" ss:DefaultRowHeight="14.4">
            <Column ss:AutoFitWidth="0" ss:Width="95.399999999999991"/>
            <Row ss:AutoFitHeight="0" ss:Height="25.2">
                <Cell ss:StyleID="m45881984"><Data ss:Type="String" xmlns="http://www.w3.org/TR/REC-html40">g<B>g</B><Font html:Color="#00FFFF">gttt</Font><Font html:Color="#FF0000">t</Font><Font html:Face="Algerian" x:Family="Decorative" html:Color="#FF0000">tt</Font><Font html:Color="#FF0000">tt</Font><Font html:Color="#00FFFF">t</Font><B><Font html:Color="#00FFFF">g</Font><I><Font html:Size="16" html:Color="#00FFFF">gg</Font></I><Font html:Size="16" html:Color="#00FFFF">g</Font></B><Font html:Color="#00FFFF">gggg gggggggggghhhhhhhhhhhhhh</Font></Data></Cell>
            </Row>
        </Table>
    </Worksheet>
</Workbook>

on voit bien que dans le innerhtml de la cellule la 1 ere lettre n'est pas dans une balise et donc pas de format

alors

pour l'exemple je le fait en string mais dans la fonction finale se sera fait en DOM dans un htmldocument object
maintenant je rajoute ce qui est en gras dans la sub

Code :

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

1
2
3
4
5
6
7
' la cellule au format  HTML : "
        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 innerhtmls Like "*Font*" Then
        innerhtmls = "<FONT style=""fontfamily:" & Font_Name & ";" & "fontSize:" & Font_Size & ";" & "color:" & Font_Color & ";"">" & innerhtmls & "</FONT>"
        End If

resultat

propriété Globale du texte de la cellule :
Calibri 11 #000000

la cellule au format text :
gggtttttttttgggggggg gggggggggghhhhhhhhhhhhhh

la cellule au format HTML :
<FONT style="fontfamily:Calibri;fontSize:11;color:#000000;">g<B>g</B><Font Color="#00FFFF">gttt</Font><Font Color="#FF0000">t</Font><Font Face="Algerian" xmlns="urn:schemas-microsoft-com:office:excel" x:Family="Decorative" Color="#FF0000">tt</Font><Font Color="#FF0000">tt</Font><Font Color="#00FFFF">t</Font><B><Font Color="#00FFFF">g</Font><I><Font Size="16" Color="#00FFFF">gg</Font></I><Font Size="16" Color="#00FFFF">g</Font></B><Font Color="#00FFFF">gggg gggggggggghhhhhhhhhhhhhh</Font></FONT>

on a ainsi un innerhtml bien nikel

en vrai il y a une coquille
Font Size="16"

que je corrige déjà dans la fonction en dom car la propriété size de la balise font a pour limite "7" il faut remanier en CSS avec ppx

[pijaku]

Non ça n'est pas très complexe.
Par contre, la méthode "propre" pour récupérer ton innerHtml est une véritable usine à gaz...
Garde la tienne!

[patricktoulon]

fonction finale avec (correction/conversion) des échelles fontsize

Code :

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

1
2
3
4
5
6
7
8
9
10
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("b3")
    Debug.Print htmltexte(cel, doc)
End Sub

fonction

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
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$, 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"): Font_Name = fontprop(1).getAttribute("ss:FontName")    'le font name
        Font_Size = fontprop(0).getAttribute("ss:Size"): Font_Size = fontprop(1).getAttribute("ss:Size")    'le font size
        'fontcolor
        i = IIf(Not IsNull(cel.Font.Color), 1, 0)
        Font_Color = fontprop(i).getAttribute("ss:Color")
        '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 'si c'est une date elle sera affichée a l'identique qu'Excel 
        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

sauf méprise de ma part c'est bien moins lourd et moins de moilin que mes fonction "BYSPAN" et "textesylé" dans mes contributions concernant la convention d'une plage excel en html

[pijaku]

Salut Patrick,

Je t'ai mis un petit

Pourquoi petit?

1- Parce que ton code omet (volontairement??) certaines propriétés des polices.
Quid de :

1. Bold,
2. Italic,
3. Underline...

surement parce que tu n'en as pas besoin.

2- Parce que la cellule elle-même (interior (color, pattern), borders) est également omise.
Volonté de ta part ou oubli?

3- Je modifierais les lignes 16 à 18 comme ceci :

Code :

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

1
2
3
4
5
6
If IsDate(cel.Value) Then 
    innerhtmls = cel.Text 'si c'est une date elle sera affichée a l'identique qu'Excel  
Else
    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)
End If

Plus de lignes de code, mais aussi plus logique : si cel est une date, tu t'évites 3 Split et 2 Replace...


Sinon, question subsidiaire, comment gérerais tu toute une plage?
Une fonction qui génèrerai un tableau html à partir d'une feuille Excel, avec toutes les balises <table><tr><td> ??

Ceci étant dit, tu mérites ton

[patricktoulon]

re
bonjour pijaku o
ui effectivement les bold et italic global ne sont pas traités
je l'ai pourtant fait dans la version avec split sur extraitxml

il faut que j'ajoute effectivement une variable traité identiquement a fontname et font_size
cela est utile pour la même raison
soit tout est en gras/italic et le innerhtml dans data est en innertext soit ce n'est qu'une partie et la il y a des fonts dans data


pour la gestion d'une plage

oui je suppose que tu a pensé mettre toute la plage dans l'extraitxml mais malheureusement ce n'est pas possible

pourquoi

parce que dans l'extrait d'une plage les cellules vides ne sont même pas représentées(absentes )

donc pour la construction ca risque d'être un peu compliqué

j'ai donc gardé mes 2 solutions dont la première est une double boucle (rows/cell )

cela dit il serait intéressant de creuser sur les ID de cell dans l'extraitXML car dans un fichier xml solide loader avec excel les cellules sont a la bonne place
je suppose donc que les id sont numérotées en fonction de leur emplacement et/ou d'autre propriétés (je vois que ca )



pour économiser il est fort possible que je crée une seule fois l object xmldom dans la sub de création de la table et le manipule dans la fonction

pense tu que la création d'un object xmldom par fonction (htmltexte/bordure css /alignement css /) soit lourd

ou devrais je récupérer tout les properties que je souhaite dans une variable typé (globale) par exemple dans une seule fonction déclenché par cellules

POUR INFO
voila comment je créée ma table de base (sans style css) argument optional

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
Function Grille_To_Html_Base(plage, Optional interior_style As Boolean = False, Optional border_style As Boolean = False)
    Dim ppx, doc As Object, TR, TD, TABLO, i#, col#, cel
    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"' bordure xlnone d'office au depart
                    If border_style = True Then
                        bordure cel, TD
                    End If
 
                    If interior_style = True Then
                        If cel.Value <> "" Then TD.innerhtml = text_stylé(cel, doc)' appel a la fonction  text_stylé
                        TD.Style.backgroundcolor = interiorcolor(cel)'appel a la fonction interiorcolor
                    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_Base = .body.innerhtml
    End With
End Function

teste la sans argument sauf la plage tu aura une table sans couleur et font style (c'est la base )

[pijaku]

En fait, l'id correspond à un style.
Donc tu ne peux pas t'en servir.
Par contre, tu as des index de ligne et de colonne...
Ici j'ai appliqué le style d'ID = s62 dans les cellules : I2, I4, J5, K2 et K5 et ai "injecté" le Range("I1:K5").

Résultat :

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
    <Worksheet ss:Name="Feuil1">
        <Table ss:ExpandedColumnCount="3" ss:ExpandedRowCount="5" ss:DefaultColumnWidth="60" ss:DefaultRowHeight="15">
            <Row>                                              'pas d'index, mais pas forcément la première ligne ici il s'agit de la ligne 2
                <Cell ss:StyleID="s62"/>                       'pas d'index donc 1ère colonne sure
                <Cell ss:Index="3" ss:StyleID="s62"/>          'index = 3 donc 3ème colonne sure
            </Row>
            <Row ss:Index="4">                                 'index = 4 donc 4ème ligne sure
                <Cell ss:StyleID="s62"/>                       'pas d'index donc 1ère colonne sure
            </Row>
            <Row>                                              'pas d'index donc ligne suivante sure
                <Cell ss:Index="2" ss:StyleID="s62"/>          'index = 2 donc 2ème colonne sure
                <Cell ss:StyleID="s62"/>                       'pas d'index donc colonne suivante : 3ème sure
            </Row>
        </Table>
    </Worksheet>

Par conséquent, tu n'as aucun de déterminer à coup sur qu'elle est la première ligne.
Si celle-ci est vide ou ne comporte pas de style, tu ne sais pas.
Par conséquent, il va te falloir imposer une contrainte, au choix :
> la première ligne du Range doit être une ligne d'entêtes,
> la première ligne du Range doit avoir une couleur particulière (même blanc...),
> encore mieux, lors du premier appel de ta fonction, tu vérifies si la cellule Plage(1, 1) à un style ou un texte, si ce n'est pas le cas, tu appliques ce code :

Code :

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

Plage.Cells(1, 1).Interior.Pattern = xlNone

Ce code ne modifiera rien de ta feuille, mais va créer une nouvelle balise Style avec dedans : <interior/>.

devrais je récupérer tout les properties que je souhaite dans une variable typé (globale) par exemple dans une seule fonction déclenché par cellules

C'est ce que je penses également.
Code surement plus propre...

[patricktoulon]

je vais regarder de plus prêt

pour les bolds et italic problème résolu
je n'ai pas vraiment besoins de le récupérer dans l'extraitXML

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
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$, Font_bold$, Font_italic, 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"): Font_name = fontprop(1).getAttribute("ss:FontName")    'le font name
        Font_size = fontprop(0).getAttribute("ss:Size"): Font_size = fontprop(1).getAttribute("ss:Size")    'le font size
        'fontcolor
        i = IIf(Not IsNull(cel.Font.Color), 1, 0)
        Font_Color = fontprop(i).getAttribute("ss:Color")
        'le font bold global
        Font_bold = "normal"
        If Not IsNull(cel.Font.Bold) Then Font_bold = "bold"
        'le font italic global
        Font_italic = Null
        If Not IsNull(cel.Font.Italic) Then Font_italic = True
        '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
        With doc.createelement("FONT")
            .face = Font_name: .Style.Color = Font_Color: .Style.FontSize = Font_size * ppx:
                    .innerhtml = IIf(Font_italic = True, "<i>", "") & Replace(innerhtmls, "xmlns:x=""urn:schemas-microsoft-com:office:excel", "") & IIf(Font_italic = True, "</i>", "")
            .Style.fontWeight = Font_bold
            '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

et si on réfléchi bien
on pourrait faire dans la création du font

Code :

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

1
2
3
4
if not isnull(cell.font.color) then propriété color de de la cellule ' sinon c'est le thisworkbook.styles("normal").font.color
'etc...
'l'extrait xml servirais simplement a récupérer le code innerhtml si il y aurais des balises FONT
end if

[pijaku]

Petite question parce que ça fait longtemps que je n'ai pas codé en html:css...

Comment injectes tu le style css dans une table html?

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
23
<!DOCTYPE html>
<html>
    <head>
        <meta charset="utf-8" />
        <style>
            td_1 {border: 1px solid black;}
        </style>
        <title>Test</title>
    </head>
 
    <body>
      <table>
        <tr>
          <th>Mois</th>
          <th>Année</th>
        </tr>
        <tr>
          <td>Janvier</td>
          <td css = td_1>2017</td> '???????????????????????
        </tr>
      </table>
   </body>
</html>

[patricktoulon]

en DOM et VB

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
 with createobject("htmlfile")
.body.innerhtml="<div></div>"
set mondiv=.getelementsbytagname("DIV")(0)
 
'application des styles css
 
mondiv.style.BackGroundColor="#ff0000" ou rgb(255,0,0) le font en couleur 
 
mondiv.style fontWeight="bold"   le font bold OU ="normal"  (tu peut mettre aussi des numéros 1,2,3,etc....)
 
'la bordure globale(les 4 coté d'un coup)
mondiv.style.border="1px solid blue" 'bordure bleu 1 px d'épaisseur
 
'si tu veux différente bordure sur les coté 
 
'exemple
'mondiv.style.borderleft="...pareil que pour un globale)
'mondiv.style.bordertop="...pareil que pour un globale)
'mondiv.style.borderright="...pareil que pour un globale)
'mondiv.style.borderbottom="...pareil que pour un globale)
end with

en fait la ou une propriété en css s'écrit partie1-partie2 en dom elle s'écrit partie1partie2

et pour l'applique c'est element.style.propriétécss="......"

element.style

fontsize =taille
fontfamily = font name
color=fontcolor
fontWeight=épaisseur de l'écriture(bold/normale/chiffre)
fontitalic=italic rarement utilis2 puisque balise "<em>" ou "<i>"
ETC....

[pijaku]

Ouais.
Ok.
Je me fourvoyais alors.

En fait, lorsque tu regardes le docxml.xml, tu as :
> dans le <Styles> : le css
> dans la <table> : le html
Mais ça ne t'aide pas dans la piste que tu suis.

[patricktoulon]

oui on a tout mais dans un format xml ,mais on peu tout récupérer

ca reste quand même une solution moins lourde que mon moulin BYSPAN ou textestylé(version 2016)
apres si on devrait pas se casser la tete puisque tu veux tout

voici la version avec split que j'ai finalisé

dans cet exemple j'ai adopter un autre raisonnement pour le( bold ,underline et strikeghout et italic par defaut)a savoir pas en css mais en dom c'est a dire en balise "<b> ,<u>,<i>,<strike>"
je ne converti plus les fontsize aussi je reste en point je fait juste sauter les "size" des font car la limite est "7" donc je passe en stylecss le .size mais reste en points
je te laisse regarder

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
Option Explicit
Sub test6()
    Dim doc As Object
    Set doc = CreateObject("htmlfile")
    Debug.Print texthtml2([A1], doc)
End Sub
Function texthtml2(cel, doc)
    Dim EXTRAITXML, workBstyle As Object, Fname$, Fsize$, fbold$, Fcolor$, Fitalic$, InnerH$, InnerHtmls$, FunderL$, Fbarré$, i#, Fonts As Object
    EXTRAITXML = Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")
    Set workBstyle = ThisWorkbook.Styles("normal")
    Fname = IIf(Not IsNull(cel.Font.Name), cel.Font.Name, workBstyle.Font.Name)
    Fsize = IIf(Not IsNull(cel.Font.Size), cel.Font.Size, workBstyle.Font.Size)
    fbold = IIf(Not IsNull(cel.Font.Bold), "<B>", "")
    Fcolor = IIf(Not IsNull(cel.Font.Color), Split(Split(EXTRAITXML, "ss:Color=""")(2), Chr(34))(0), "#000000")
    Fitalic = IIf(Not IsNull(cel.Font.Italic), "<i>", "")
    FunderL = IIf(cel.Font.Underline > 0, "<u>", "")
    Fbarré = IIf(cel.Font.Strikethrough, "<STRIKE>", "")
    If IsDate(cel.Value) Then
        InnerH = cel.Text
    Else
        InnerH = Split(EXTRAITXML, "<Data")(1)
        InnerHtmls = Replace(Split(Split(InnerH, Split(InnerH, ">")(0) & ">")(1), "</Data>")(0), "html:", "")
    End If
    With doc.createelement("FONT")
        With .Style: .fontfamily = Fname: .FontSize = Fsize & "pt": .Color = Fcolor:: End With
        .innerhtml = fbold & Fbarré & Fitalic & FunderL & InnerHtmls & IIf(FunderL <> "", "</u>", "") & IIf(Fitalic <> "", "</i>", "") & IIf(Fbarré <> "", "</STRIKE>", "") & IIf(fbold <> "", "</b>", "")
        Set Fonts = .getElementsByTagName("FONT")
        For i = 0 To Fonts.Length - 1
            If Fonts(i).Size <> "" Then Fonts(i).Style.FontSize = Fonts(i).Size & "pt": Fonts(i).Size = ""
        Next
        texthtml2 = .outerhtml
    End With
 
End Function

[patricktoulon]

oupss!! non tu te fourvoyais pas
tu parle du style outline tandis que moi je style inline (style dans le outertext de l'élément)
c'est réalisable aussi je le fait dans ma contribution
j'extrais le style inline et le met dans la balise style global