Créer et analyser un document xml en mémoire

**patricktoulon** · 20/09/2017, 23h34

j'ai déjà trouvé une super coquille dans mon raisonnements

l'attribut "ID" déontologiquement en html il ne peut pas en avoir plusieurs
donc dans la boucles sur les nœuds xml seul le premier td est stylé quand on style inline
et M....!!!!

re c'est bon j'ai fini je t'envoie ca demain

j'ajouterais au fur et a mesure des fonctions comme par exemple les font dégradé de cellules

**pijaku** · 21/09/2017, 09h05

Patrick, le forum,
Bonjour,

Pour paraphraser Pierre Fauconnier (je n'ai pas retrouvé la discussion) :

En ce qui concerne les usines à gaz, nous avons des contributeurs très fort pour cela

J'ai l'honneur de t'annoncer, Patrick, que nous sommes les meilleurs des meilleurs!
J'ai commencé la mienne (d'usine à gaz) parce que la découverte de la Library MSXML2 m'a "passionné".

En prenant du recul, ces deux derniers jours m'ont permis d'ouvrir les yeux sur ta demande.
J'ai donc simplement tout revu en modifiant l'angle d'attaque.

résultat : Inutile de refaire entièrement ce que Microsoft a déjà prévu...

Principe :

on enregistre le classeur au format html,
on extrait le css et le html,
on enregistre le classeur au format xlsm (retour à l'origine),
on créé deux fichiers (un css et un html)
on nettoie (suppression fichier et répertoire)

Ca tient en 50 lignes de code...

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
Option Explicit
 
Private Const CHEMIN As String = "C:\Users\pijaku\Desktop\"
Private Const NOMFICHIER As String = "Classeur184"
Private Const NOMSOUSREP As String = "Classeur184_fichiers"
Private Const NOMFICHIERHTML As String = NOMFICHIER & ".htm"
Private Const NOMFICHIERXLSM As String = NOMFICHIER & ".xlsm"
Private Const NOMFEUILLE As String = "Sheet001.htm"
Private Const NOMFEUILLEDESTYLE As String = "stylesheet.css"
 
Public Sub Creation_Html_Et_Css()
Dim Html() As String, Css() As String
 
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .SaveAs Filename:=CHEMIN & NOMFICHIERHTML, FileFormat:=xlHtml
        Html = LireFichier(CHEMIN & NOMSOUSREP & "\", NOMFEUILLE)
        Css = LireFichier(CHEMIN & NOMSOUSREP & "\", NOMFEUILLEDESTYLE)
        .SaveAs Filename:=CHEMIN & NOMFICHIERXLSM, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    End With
    Application.DisplayAlerts = True
    Call EcrireFichier(CHEMIN, NOMFICHIERHTML, Html, "<body ")
    Call EcrireFichier(CHEMIN, NOMFEUILLEDESTYLE, Css)
    Call Shell("cmd /c RD /S /Q " & CHEMIN & NOMSOUSREP)
    Kill CHEMIN & NOMFICHIERHTML
End Sub
 
Private Function LireFichier(Ch As String, F As String) As String()
Dim Tb() As String, num As Long, i As Long
 
    num = FreeFile
    Open Ch & F For Input As #num
        i = -1
        While Not EOF(1)
          i = i + 1
          ReDim Preserve Tb(i)
          Line Input #1, Tb(i)
        Wend
    Close #num
    LireFichier = Tb
End Function
 
Private Sub EcrireFichier(Ch As String, F As String, Contenu() As String, Optional BaliseDebut As String)
Dim num As Long, i As Long, debut As Long
 
    num = FreeFile
    Open Ch & F For Output As #num
        If BaliseDebut <> vbNullString Then
            For i = LBound(Contenu) To UBound(Contenu)
                If Contenu(i) Like BaliseDebut & "*" Then debut = i: Exit For
            Next i
        Else
            debut = LBound(Contenu)
        End If
        For i = debut To UBound(Contenu)
            Print #1, Contenu(i)
        Next i
    Close #num
End Sub

Après, il y aura peut-être un peu de nettoyage à faire, mais uniquement si tu le souhaites.

**patricktoulon** · 21/09/2017, 10h04

Bonjour pijaku

je viens de tester ton nouveau code

j'obtiens un html avac une table vide et mal dimensionnée

le css

il y a encore beaucoup de nettoyage a faire
tout ce qui est mso il faut le supprimer car sinon il nous faut en haut de fichier les balise meta avec les lien du mime

et donc ces mso il faut les transformer en style css classique très difficile d'avoir les équivalent car des fois ils n'existent pas

crois moi si l'option du html enregistré je l'ai zappé il y a fort longtemps c'est bien parce que je m'étais rendu compte que le rendu était loin de restituer l'original a moins de garder le fichier html tel qu'el que Excel l'a enregistré en acceptant quelque manque au niveau css et quelques différences ici et la

hier j'ai revu la fonction style au lieu de styler la table je cré le code css a part comme tu l'a fait

et oui en effet je commence a apprécier travailler sur du XML même si je considéré qu'avoir 2 fonction pour déterminer un élément mais que ces deux fonctions n'ont pas les même propriété (le xmlnode/domelement) est complètement inutile e

en html l'élément tout court possède toute ces fonctions et attributs(innerhtml,innertext,outerhtml,outertext,getattribute,setattribute,id,classname,style etc......

après pour être honnête avec le xml je gagne le innerhtml to fait par rapport a mes ancienne versions

mais le code est inexploitable si je veux intégré cette table dans un document ou alors oui la on part dans une usine a gaz

fait simplement ce test
enregistre un fichier avec des fusions ,des couleur du texte de différent format dans les cellule des fusion qui se croisent ect.....

tu sera decu du rendu du fichier html qui a été fait par "MICROSOFT" comme tu dis

pour en revenir a ta dernière démo je fait quoi du html? (j'ai pas compris le but)
car non seulement elle est vide mais on a un soucis de dimensionnement et encore une fois les merge cell sont décalées pour certaines et absentes pour d'autres

démo de ce qui sort de ta dernier démo

comme tu peut le voir il est difficile d'en exploiter les nuances en ce qui concerne les fusions d'ailleurs le résultat parle de lui même (fusions mal placées , manquantes) et ce n'est que la structure html de base

tu n'a pas de innerhtml de style etc....
Nom : Capture.JPG
Affichages : 189
Taille : 174,8 Ko

Nom : Capture.JPG
Affichages : 189
Taille : 174,8 Ko

tu peux me croire si je te dis qu'a moins d'enregistrer le classeur en html (pour l'avoir en html tel quel ) en acceptant quelque ratés c'est le but alors ok sinon Non!!

sinon tu pense bien que je m'en passerais car en ce qui me concerne ce n'est que le début après reste a intégrer comme je te l'ai dis précédemment les fonctions de calcul des cellules

ma dernier fonction css (séparé du html)

**pijaku** · 21/09/2017, 10h26

Et pourtant...

Avec mon code, juste en ajoutant ceci au fichier html :

Code :

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

1
2
3
4
5
6
<!DOCTYPE html>
<html>
    <head>
        <meta charset="utf-8" />
        <link rel="stylesheet" href="stylesheet.css" />
    </head>

Bien sur il faut lier le html au css...
J'obtiens cecI /
Nom : Sans ti.png
Affichages : 209
Taille : 297,6 Ko

EDIT : il se peut que les constantes indiquées dans mon code ne soient pas les mêmes sur ton pc...

**patricktoulon** · 21/09/2017, 10h44

oui je vois
je n'ai pourtant rien changer a ton code sauf le user pour le chemin
oui en effet j'ai pas lier le css mais dans tout les cas ca peut pas etre bon si la base n'est pas conforme

quand a moi ma base html c'est ca (il ne peut pas y avoir d'erreur s)
et on est loin de l'usine a gaz
sub de teste avec apercu direct dans IE

Code :

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

1
2
3
4
5
6
7
8
Sub testtablebase()
    Set plage = Range("a1:j10")
    'Debug.Print tablebase(plage)
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True
    IE.navigate "about:blank"
    IE.document.write tablebase(plage)
End Sub

la 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
31
32
 
Function tablebase(plage)
    Dim ppx, TR, TD, Tablo, i#, col#, cel, r, FZ$, doc
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    FZ = Val(ThisWorkbook.styles("Normal").font.Size * ppx) & "px"
    Set doc = CreateObject("htmlfile")
    With doc
        .body.innerhtml = "<table><TBODY></TBODY></table>"
        With .getElementsByTagName("TABLE")(0):
            .Style.Width = (plage.Width + 3) * ppx: .Style.bordercollapse = "collapse": .cellspacing = 0: .Style.FontSize = FZ
            r = .setattribute("range", Replace(plage.Address, "$", ""))
        End With
        Set Tablo = .getElementsByTagName("TBODY")(0)
        For i = 1 To plage.Rows.Count
            Set TR = .createelement("TR"): r = TR.setattribute("ligne", plage.Cells(i, 1).ROW)
            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
                    'cel.AddComment
                    'cel.Comment.Text Text:=Replace(cel.MergeArea.Address, "$", "")' je me sert des comment pour les reperer dans xml dans les fonctions xml
                    Set TD = .createelement("TD"): r = TD.setattribute("address", Replace(cel.MergeArea.Address, "$", ""))
                    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"
                    TR.appendchild (TD)
                End If
            Next
        Next
    End With
    tablebase = doc.body.innerhtml
End Function

comme tu peut le voir les fusions sont au bon endroit
Nom : Capture.JPG
Affichages : 216
Taille : 151,1 Ko

**pijaku** · 21/09/2017, 10h51

je n'ai pourtant rien changer a ton code sauf le user pour le chemin

C'est peut-être là le souci...
Si les constantes ne sont pas les mêmes sur nos deux pc, tu ne créeras qu'une table vide.
A vérifier donc, en enregistrant ton classeur manuellement en htm :

Code :

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

1
2
3
4
 
Private Const NOMSOUSREP As String = "Classeur184_fichiers" 'sous répertoire créé automatiquement dans le répertoire du classeur
Private Const NOMFEUILLE As String = "Sheet001.htm"            'fichier html correspondant à ma feuille (Feuil1)
Private Const NOMFEUILLEDESTYLE As String = "stylesheet.css" 'fichier css

**patricktoulon** · 21/09/2017, 11h32

j'y comprend rien j'ai bien le dossier créé
avec le fichier en html mais le fichier html résultat autre que: le classeur enregistré en html ou il est???

le classeur-184 identique a sheets001.html en terme de code

et même la on remarque déjà des nuances en terme de bordures qui n'existent pas en html et que moi je transforme pour les faire exister dashdot devient dashed en 3 px etc.........

que l'on soit bien d'accords

je ne veut dans le html que la table prise en considération par la variable plage même si le sheets est plus rempli
et dans le css pareil uniquement les propriété de la table en paramètre sans les MSO et meta
c'est bien ca que tu a voulu me montrer?

d'autant plus que si je charge le contenu du fichier classeur184 et que je split le text par "<body" j'en trouve 4 heu.....

Invité · 22/09/2017, 07h25

Bonjour,

Le xml contient déjà sa feuille de style, il semblerait qu'il soit possible de l'insérer dans du HTML!

http://www.eyrolles.com/Chapitres/97...0401/chap6.pdf

Indépendamment de ça,comme tu disposes des nodes de styles tu peux affecter ta classe aux <TD Class='Titre'>!
Tu gère le style indépendamment du tableau!

https://www.developpez.net/forums/d1...l/#post9631470

**patricktoulon** · 22/09/2017, 10h54

Bonjour Robert

c'est pas mal tes lien j'en apprends beaucoup

ceci dit j'ai tourner cela dans tout les sens

pour construire une table html avec le xml nous avons plusieurs soucis

certaines cellule n'y figurent pas parce qu'elle sont vides ou qu'il y a eu des fusions de colonnes avant sur la même ligne ou sur plusieurs lignes avant

les ids attribuées :il est difficile (même impossible )de les relier aux cellules html QUAND !!!!aucun repère n'est disponible
parti de la je préfère construire ma table a l'ancienne boucle (row/cells)pas de sélection donc relativement rapide
c'est beaucoup moins tordu comme code (facile a déboguer)

en créant ma table html comme cela en même tant dans les boucle j'ajute un commentaire aux cellule dans le quel j'y met leur address

ainsi dans le xml même si j'ai pas toutes les cellules j'ai une balise comment enfant de la balise "cell" il m'est donc très facile de repairer la correspondance de la cell xml et la cell html

conclusion
j'en ai appris beaucoup sur le xml c'est toujours ca de prit
mais pour une conversion xml/html il faut faire en sorte de pouvoir les repérer distinctement exemple ma dernière version dans le xml j'ai un comment avec l'adresse de la cellules

mais avant créer la table
pour te donner une idée de la simplicité
en crevant ma table par les boucles (rox/cells) je peux styler toute les propriétés qui sont globales des cellules sans passer par le xml
il ne me reste plus qu'a aller chercher les bordures et le innerhtml en cas de caractères de différentes couleur ou format dans la cellules : a la fin de ma construction c'est tout ce qui me manque

Invité · 22/09/2017, 11h29

Code xlRangeValueMSPersistXML :

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
<xml xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882" xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882" xmlns:rs="urn:schemas-microsoft-com:rowset" xmlns:z="#RowsetSchema"> <x:PivotCache>
<x:CacheIndex>1</x:CacheIndex>
<s:Schema id="RowsetSchema">
<s:ElementType name="row" content="eltOnly">
<s:attribute type="Col1"/>
<s:attribute type="Col2"/>
<s:extends type="rs:rowbase"/>
</s:ElementType>
<s:AttributeType name="Col1" rs:name="Champ1">
<s:datatype dt:maxLength="255"/>
</s:AttributeType>
<s:AttributeType name="Col2" rs:name="Champ2">
<s:datatype dt:maxLength="255"/>
</s:AttributeType>
</s:Schema>
<rs:data>
<z:row Col1="A1" Col2="B1"/>
<z:row Col1="A2" Col2="B2"/>
<z:row Col1="A3" Col2="B3"/>
<z:row/>
<z:row Col2="B5"/>
<z:row/>
<z:row Col1="A7" Col2="B7"/>
<z:row Col1="A8" Col2="B8"/>
<z:row Col1="A9"/>
<z:row Col1="A10" Col2="B10"/>
</rs:data>
</x:PivotCache>
</xml>

Code xlRangeValueXMLSpreadsheet :

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
<?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="s64">
<Borders>
<Border ss:Position="Bottom" ss:LineStyle="Continuous" ss:Weight="1"/>
<Border ss:Position="Left" ss:LineStyle="Continuous" ss:Weight="1"/>
<Border ss:Position="Right" ss:LineStyle="Continuous" ss:Weight="1"/>
<Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="1"/>
</Borders>
<Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#FF0000"/>
<Interior ss:Color="#FFFF00" ss:Pattern="Solid"/>
</Style>
</Styles>
<Worksheet ss:Name="Feuil1">
<Table ss:ExpandedColumnCount="2" ss:ExpandedRowCount="10" ss:DefaultColumnWidth="60" ss:DefaultRowHeight="15">
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A1</Data></Cell>
<Cell><Data ss:Type="String">B1</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A2</Data></Cell>
<Cell><Data ss:Type="String">B2</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A3</Data></Cell>
<Cell><Data ss:Type="String">B3</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"/>
</Row>
<Row>
<Cell ss:StyleID="s64"/>
<Cell><Data ss:Type="String">B5</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"/>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A7</Data></Cell>
<Cell><Data ss:Type="String">B7</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A8</Data></Cell>
<Cell><Data ss:Type="String">B8</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A9</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A10</Data></Cell>
<Cell><Data ss:Type="String">B10</Data></Cell>
</Row>
</Table>
</Worksheet>
</Workbook>

Code Fusion A1:B1 :

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
<xml xmlns:x="urn:schemas-microsoft-com:office:excel" xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882" xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882" xmlns:rs="urn:schemas-microsoft-com:rowset" xmlns:z="#RowsetSchema"> <x:PivotCache>
<x:CacheIndex>1</x:CacheIndex>
<s:Schema id="RowsetSchema">
<s:ElementType name="row" content="eltOnly">
<s:attribute type="Col1"/>
<s:attribute type="Col2"/>
<s:extends type="rs:rowbase"/>
</s:ElementType>
<s:AttributeType name="Col1" rs:name="A1">
<s:datatype dt:maxLength="255"/>
</s:AttributeType>
<s:AttributeType name="Col2" rs:name="Champ1">
<s:datatype dt:maxLength="255"/>
</s:AttributeType>
</s:Schema>
<rs:data>
<z:row Col1="A2" Col2="B2"/>
<z:row Col1="A3" Col2="B3"/>
<z:row/>
<z:row Col2="B5"/>
<z:row/>
<z:row Col1="A7" Col2="B7"/>
<z:row Col1="A8" Col2="B8"/>
<z:row Col1="A9"/>
<z:row Col1="A10" Col2="B10"/>
</rs:data>
</x:PivotCache>
</xml>

Code Fusion A1:B1 :

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
<?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="s64">
<Borders>
<Border ss:Position="Bottom" ss:LineStyle="Continuous" ss:Weight="1"/>
<Border ss:Position="Left" ss:LineStyle="Continuous" ss:Weight="1"/>
<Border ss:Position="Right" ss:LineStyle="Continuous" ss:Weight="1"/>
<Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="1"/>
</Borders>
<Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#FF0000"/>
<Interior ss:Color="#FFFF00" ss:Pattern="Solid"/>
</Style>
<Style ss:ID="s68">
<Alignment ss:Horizontal="Center" ss:Vertical="Bottom"/>
<Borders>
<Border ss:Position="Left" ss:LineStyle="Continuous" ss:Weight="1"/>
</Borders>
<Font ss:FontName="Calibri" x:Family="Swiss" ss:Size="11" ss:Color="#FF0000"/>
<Interior ss:Color="#FFFF00" ss:Pattern="Solid"/>
</Style>
</Styles>
<Worksheet ss:Name="Feuil1">
<Table ss:ExpandedColumnCount="2" ss:ExpandedRowCount="10" ss:DefaultColumnWidth="60" ss:DefaultRowHeight="15">
<Row>
<Cell ss:MergeAcross="1" ss:StyleID="s68"><Data ss:Type="String">A1</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A2</Data></Cell>
<Cell><Data ss:Type="String">B2</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A3</Data></Cell>
<Cell><Data ss:Type="String">B3</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"/>
</Row>
<Row>
<Cell ss:StyleID="s64"/>
<Cell><Data ss:Type="String">B5</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"/>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A7</Data></Cell>
<Cell><Data ss:Type="String">B7</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A8</Data></Cell>
<Cell><Data ss:Type="String">B8</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A9</Data></Cell>
</Row>
<Row>
<Cell ss:StyleID="s64"><Data ss:Type="String">A10</Data></Cell>
<Cell><Data ss:Type="String">B10</Data></Cell>
</Row>
</Table>
</Worksheet>
</Workbook>

Code HTML :

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
 Sub test()
Set docxml = CreateObject("MSXML2.DOMDocument")
Set r = ActiveSheet.UsedRange
With docxml
If Not .LoadXML(Replace(r.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then Err.Raise .parseError.ErrorCode, , .parseError.reason
Dim T() As String
l = r.Rows.Count - 1
c = r.Columns.Count - 1
ReDim T(l, c)
For l2 = 0 To l
For c2 = 0 To c
 If Trim("" & r(l2 + 1, c2 + 1)) <> "" Then T(l2, c2) = r(l2 + 1, c2 + 1) Else T(l2, c2) = "&nbsp;"
Next
Next
HTML = "<Table border='1'>"
For l2 = 0 To l
HTML = HTML & vbCrLf & "<tr>"
For c2 = 0 To c
HTML = HTML & "<td Clase='cells(" & l2 & "," & c2 & ")'>" & T(l2, c2) & "</td>"
Next
HTML = HTML & "</tr>"
Next
HTML = HTML & vbCrLf & "</table>"
HTML = Replace(HTML, "'cells(0,0)'", "'S68'")
HTML = Replace(HTML, "'cells(0,1)'", "'S68'")
Debug.Print HTML
End With
End Sub

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
<Table border='1'><tr><td Clase='S68'>A1</td><td Clase='S68'>B1</td></tr>
<tr><td Clase='cells(1,0)'>A2</td><td Clase='cells(1,1)'>B2</td></tr>
<tr><td Clase='cells(2,0)'>A3</td><td Clase='cells(2,1)'>B3</td></tr>
<tr><td Clase='cells(3,0)'>A4</td><td Clase='cells(3,1)'>B4</td></tr>
<tr><td Clase='cells(4,0)'>A5</td><td Clase='cells(4,1)'>B5</td></tr>
<tr><td Clase='cells(5,0)'>A6</td><td Clase='cells(5,1)'>B6</td></tr>
<tr><td Clase='cells(6,0)'>A7</td><td Clase='cells(6,1)'>B7</td></tr>
<tr><td Clase='cells(7,0)'>A8</td><td Clase='cells(7,1)'>B8</td></tr>
<tr><td Clase='cells(8,0)'>A9</td><td Clase='cells(8,1)'>B9</td></tr>
<tr><td Clase='cells(9,0)'>&nbsp;</td><td Clase='cells(9,1)'>&nbsp;</td></tr>
<tr><td Clase='cells(10,0)'>&nbsp;</td><td Clase='cells(10,1)'>&nbsp;</td></tr>
<tr><td Clase='cells(11,0)'>&nbsp;</td><td Clase='cells(11,1)'>&nbsp;</td></tr>
<tr><td Clase='cells(12,0)'>&nbsp;</td><td Clase='cells(12,1)'>&nbsp;</td></tr>
<tr><td Clase='cells(13,0)'>&nbsp;</td><td Clase='cells(13,1)'>&nbsp;</td></tr>
<tr><td Clase='cells(14,0)'>A15</td><td Clase='cells(14,1)'>B15</td></tr>
<tr><td Clase='cells(15,0)'>A16</td><td Clase='cells(15,1)'>B16</td></tr>
<tr><td Clase='cells(16,0)'>A17</td><td Clase='cells(16,1)'>B17</td></tr>
<tr><td Clase='cells(17,0)'>A18</td><td Clase='cells(17,1)'>B18</td></tr>
<tr><td Clase='cells(18,0)'>A19</td><td Clase='cells(18,1)'>B19</td></tr>
<tr><td Clase='cells(19,0)'>A20</td><td Clase='cells(19,1)'>B20</td></tr>
<tr><td Clase='cells(20,0)'>A21</td><td Clase='cells(20,1)'>&nbsp;</td></tr>
<tr><td Clase='cells(21,0)'>A22</td><td Clase='cells(21,1)'>B22</td></tr>
<tr><td Clase='cells(22,0)'>A23</td><td Clase='cells(22,1)'>B23</td></tr>
<tr><td Clase='cells(23,0)'>A24</td><td Clase='cells(23,1)'>B24</td></tr>
<tr><td Clase='cells(24,0)'>A25</td><td Clase='cells(24,1)'>B25</td></tr>
<tr><td Clase='cells(25,0)'>A26</td><td Clase='cells(25,1)'>B26</td></tr>
<tr><td Clase='cells(26,0)'>&nbsp;</td><td Clase='cells(26,1)'>B27</td></tr>
<tr><td Clase='cells(27,0)'>A28</td><td Clase='cells(27,1)'>B28</td></tr>
<tr><td Clase='cells(28,0)'>A29</td><td Clase='cells(28,1)'>B29</td></tr>
<tr><td Clase='cells(29,0)'>A30</td><td Clase='cells(29,1)'>B30</td></tr>
<tr><td Clase='cells(30,0)'>A31</td><td Clase='cells(30,1)'>B31</td></tr>
<tr><td Clase='cells(31,0)'>A32</td><td Clase='cells(31,1)'>B32</td></tr>
<tr><td Clase='cells(32,0)'>A33</td><td Clase='cells(32,1)'>B33</td></tr>
<tr><td Clase='cells(33,0)'>A34</td><td Clase='cells(33,1)'>B34</td></tr>
</table>

**patricktoulon** · 22/09/2017, 14h56

salut robert

voila le resultat chez moi pour la plage A1:D10

il manque :
1 ligne a la fin
des cellules sur certaines lignes

resultat html

vu de la plage d'origine
Nom : Capture.JPG
Affichages : 181
Taille : 34,2 Ko

tu peux faire ce que tu veux a moins de faire une usine a gaz tu n'aura pas toutes les cellules

je le repete
mettre un comentaire a toute les cellules
dans le commentaire mettre l'addresse de la cellule

construire la table avec 2boucles(row/cells) ultra rapide
analyser le xml en passant par la balise" comment" pour en récupérer l'adresse de la cellule correspondante
une fois l'adresse récupérer remonter le parent de "comment" jusqu'à la balise "Cell" la on a le id que le xml attribut a la cells
parti de la on a l'adresse et le id correspondant a une cellule

et pourtant dans le xml on a toujours pas toute les cellules mais on ne peux plus se tromper d'index de ligne ou de cells

voila

Invité · 22/09/2017, 15h38

c'est pour cela que je différenciée la génération du Html en fonction de la plage Excel et la feuille de style en fonction de l'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
32
33
34
35
36
37
38
39
40
41
 Sub test()
 Dim savec2 As String
Set docxml = CreateObject("MSXML2.DOMDocument")
Set r = ActiveSheet.UsedRange
With docxml
If Not .LoadXML(Replace(r.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then Err.Raise .parseError.ErrorCode, , .parseError.reason
Dim T() As String
l = r.Rows.Count
c = r.Columns.Count
ReDim T(l, c)
For l2 = 0 To l - 1
For c2 = 0 To c - 1
 If r(l2 + 1, c2 + 1).MergeArea.Count > 1 Then
If Trim("" & r(l2 + 1, c2 + 1)) <> "" Then T(l2, 0) = r(l2 + 1, c2 + 1)
    T(l2, UBound(T, 2)) = " rowspan='" & r(l2 + 1, c2 + 1).MergeArea.Rows.Count & "'  colspan='" & r(l2 + 1, c2 + 1).MergeArea.Columns.Count & "'"
 Debug.Print r(l2 + 1, c2 + 1).MergeArea.Rows.Count
 Else
 If Trim("" & r(l2 + 1, c2 + 1)) <> "" Then T(l2, c2) = r(l2 + 1, c2 + 1) Else T(l2, c2) = "&nbsp;"
 End If
Next
Next
HTML = "<Table border='1'>"
For l2 = 0 To l - 1
HTML = HTML & vbCrLf & "<tr>"
For c2 = 0 To c - 1
If T(l2, UBound(T, 2)) <> "" Then
    If c2 = 0 And savec2 = "" Then HTML = HTML & "<td Clase='cells(" & l2 & "," & c2 & ")' " & T(l2, UBound(T, 2)) & " >" & T(l2, 0) & "</td>"
    savec2 = c2
Else
   HTML = HTML & "<td Clase='cells(" & l2 & "," & c2 & ")'&  >" & T(l2, c2) & "</td>"
   savec2 = ""
End If
Next
HTML = HTML & "</tr>"
Next
HTML = HTML & vbCrLf & "</table>"
HTML = Replace(HTML, "'cells(0,0)'", "'S68'")
HTML = Replace(HTML, "'cells(0,1)'", "'S68'")
Debug.Print HTML
End With
End Sub

ici le colspan est foireux! mais si je part sur une autre usine à gaz!!!

**patricktoulon** · 22/09/2017, 15h53

re
bon visiblement y a quelque chose qui t'échappe

déjà la ligne 1 tu la saute tout simplement parce que elle est dans un autre élément
voila ca c'est la raison de la ligne manquante sur le nombre tout a l'heure dans mon résultat

si je veux récupérer cette ligne je doit récupérer cet élément puis tout les "AttributeType name" puis tout ses enfant "row" puis le field(0) de ces row

et cela rien que pour la ligne 1

autrement dit autant de moulin que pour le reste même pire

ensuite si je veux récupérer les style il faut que je replace "col" par "index "(pour avoir les mêmes attribut avec les deux constantes xmlrangevalue)

on est déjà dans un truc de fou

fait moi plaisir met en commentaire leur propres address a chaque cellule et regarde le xml

Invité · 22/09/2017, 15h57

Non il n'y a rien qui m'échappe ma solution est tout simplement foirreuse!

**patricktoulon** · 22/09/2017, 17h33

re
essaie cela
regarde bien le html

ensuite debloque le debug xml

les row index X du xml correspondront au tr indexligne X du html
et pareil pour les cellules
les cell index X du xml correspondront au td index X du html

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
Sub testboucle()
    Dim plage, doc, xxml
    Set plage = Range("a1:j10")
    Set doc = CreateObject("htmlfile")
    basetable doc, plage, xxml
    Debug.Print doc.body.innerhtml
'
'Debug.Print xxml
End Sub
Sub basetable(doc, plage, xxml)
    Dim ppx, TR, TD, Tablo, i#, col#, cel, r, FZ$
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    FZ = val(ThisWorkbook.styles("Normal").font.Size * ppx) & "px"
    With doc
        .body.innerhtml = "<table><TBODY></TBODY></table>"
        With .getElementsByTagName("TABLE")(0):
            .Style.Width = (plage.Width + 3) * ppx: .Style.bordercollapse = "collapse": .cellspacing = 0: .Style.FontSize = FZ
            r = .setattribute("range", Replace(plage.Address, "$", ""))
        End With
        Set Tablo = .getElementsByTagName("TBODY")(0)
        For i = 1 To plage.Rows.Count
            Set TR = .createelement("TR")
            r = TR.setattribute("indexligne", plage.Cells(i, 1).ROW)
            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
                    cel.AddComment: cel.Comment.Text Text:=Replace(cel.MergeArea.Address, "$", "")
                    Set TD = .createelement("TD")
                    TD.iD = Replace(cel.MergeArea.Address, "$", ""): TD.colspan = Range(TD.iD).Columns.Count: TD.rowspan = Range(TD.iD).Rows.Count
                    r = TD.setattribute("address", TD.iD): r = TD.setattribute("index", cel.Column)
                    TR.appendchild (TD)
                End If
            Next
        Next
    End With
    With plage
        xxml = .Value(xlRangeValueXMLSpreadsheet)
        .ClearComments
    End With
End Sub

voila pourquoi je persiste a dire qu'il faut monter le html avant et non sur la base du xml

**patricktoulon** · 22/09/2017, 17h58

pour conclure si le xml en rebute plus d'un et que l'affichage momentané d'une fenêtre IE ne gène pas
solution a l'ancienne

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
Sub test()
    Dim plage,  IE
    Set plage = Range("a1:j10")
    Set IE = CreateObject("internetexplorer.application")
     With IE
        .Visible = True
        .navigate "about:blank"
        .document.write "<div id=calque contenteditable=true width=500  height=500 ><div>"
        .document.getelementbyid("calque").Focus
        plage.Copy
        .ExecWB 13, 17 'equivalent du ".paste de excel"  13= paste  17 = default
        Debug.Print .document.getElementsByTagName("TABLE")(0).outerhtml
        .Quit
    End With
End Sub

EDIT:
oh puré j'oubliais comme je n'utilise plus les sendkeys pour paster ie peut être invisible

pour le coup la solution est toute trouvée
reste a corriger les bordures xlnone et 2 ou 3 petit détails
pour ceux qui ne veule pas se casser la tète en voila une belle solution

Invité · 22/09/2017, 17h58

C'était mon idée, partir de la plage brute d cellules pour faire la base du html; puis utiliser le xml pour travailler sur la feuille de style!

Mais je suis parti en vrille!

**patricktoulon** · 22/09/2017, 18h09

oui parce que comme pijaku tu tenais a monter le html sur la base du xml

ca reste possible mais c'est un truc de fou avec les index et insertbefore ou appendchild pour ajouter les manquants

Invité · 22/09/2017, 18h39

Non pas du tout! Sur la base de la plage Excel!

Code :

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

1
2
3
4
5
6
7
l = r.Rows.Count
c = r.Columns.Count
ReDim T(l, c)
For l2 = 0 To l - 1
For c2 = 0 To c - 1
 If r(l2 + 1, c2 + 1).MergeArea.Count > 1 Then
If Trim("" & r(l2 + 1, c2 + 1)) <> "" Then T(l2, 0) = r(l2 + 1, c2 + 1)

**patricktoulon** · 22/09/2017, 19h12

c'est quoi le reste du code ???

Créer et analyser un document xml en mémoire

Macros et VBA Excel

Discussions similaires

Partager

Partager