Discussion :

[patricktoulon]

Bonjour a tous
je souhaiterait créer un xmldom en mémoire puis l'analyser

pour cela j'ai un code complet issu de la propriété xlRangeValueXMLSpreadsheet d'un rangemais je sais pas insérer le code complet

Code :

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

1
2
3
4
5
6
7
8
9
 
Sub essai()
    Dim ExtraitXML As String
 
    ExtraitXML = Sheets(1).Range("b3").MergeArea.Cells(1).Value(xlRangeValueXMLSpreadsheet)
    Debug.Print ExtraitXML
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    'comment insérer ici  ExtraitXML 
End Sub

[patricktoulon]

Bonjour
j'ai bien essayé de créer le root puis intégrer le code mais ca me supprime tout les "<" ou ">"

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
Sub essai1()
Dim objDom As Object
   Dim objRootElem As Object
   Dim objMemberElem As Object
   Dim objMemberRel As Object
   Dim objMemberName As Object
    Dim ExtraitXML As String, innerH$, W#, H#, WRAPP As Boolean, backcol, aligH$, aligV$
 
    ExtraitXML = Sheets(1).Range("b3").Value(xlRangeValueXMLSpreadsheet)    'xlRangeValueMSPersistXML  '
    texte = Replace("<Styles>" & Split(ExtraitXML, "<Styles>")(1), Chr(34), " ")
 
 
   Set objDom = CreateObject("MSXML2.DOMDocument")
 
   ' Creates root element
   Set objRootElem = objDom.createElement("first")
   objDom.appendChild objRootElem
   objRootElem.Text = texte
 
End sub

j'ai essayé aussi la propriété "objDom .xml" mais elle est que en lecture seule c'est balo!!

[Jean-Philippe André]

Salut Patrick,

pour t'eviter un monologue, peux-tu nous dire quelle est ta question technique stp ?

[patricktoulon]

BonjourJean- Philippe-André
la question technique est simple

je ne veux pas créer les nœuds un par un j'ai déjà un code tout prêt que je veux insérer dans l'Object

un peu comme avec le l'object htmldocument ( .body.innerhtml="blablabla")
ce code est récupérer par
exemple

Code :

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

msgbox range("A1").value(xlRangeValueXMLSpreadsheet)

je veux mettre ce code dans l'object pour le parser et en récupérer certaines données
depuis hier je l'ai fait avec les librairie de traitement de chaine de caractères mais tu t'en doute c'est un calvaire mais j'y suis arrivé mais je préfèrerais travailler avec les nodes c'est plus propre

hier je l'ai fait en enregistrant dans un fichier .xml avec open for input as freefile
puis un load sur le fichier
mais j'en ai un paquet de cellules a examiner ca m'a paru pas envisageable même si ca fonctionne

[Jean-Philippe André]

OK, mais je n'ai toujours pas reussi a trouve ta question.

J'ai bien

Code :

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

Msgbox range("A1").value(xlRangeValueXMLSpreadsheet)

qui me renvoie une structure xml

Que cherches tu exactement a faire ?


TU peux passer par un fichier xml intermediaire si ca te chante

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub patrick()
Dim strXML As String
strXML = Range("A1").Value(xlRangeValueXMLSpreadsheet)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile("C:\temp\patrick.xml")
oFile.WriteLine strXML
oFile.Close
Set fso = Nothing
Set oFile = Nothing
End Sub

Mais encore une fois je n'ai toujours pas compris ce qui motive ton post d'origine

[patricktoulon]

OK peut etre que la tu va comprendre

je veux le même résultat que le code qui suit

sans passer par la creation d'un fichier solide ".xml"

mais avec ceci si quelque chose comme ca

Code :

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

1
2
set docXML=CreateObject("MSXML2.DOMDocument"
'docXML.xml=range("A1").value(xlRangeValueXMLSpreadsheet)

pour le moment je le fait comme ceci

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
Sub testtextstyle()
Set doc = CreateObject("htmlfile")
Debug.Print text_stylé([B3], doc)
End Sub
Function text_stylé(cel, doc)
    With CreateObject("WScript.Shell"): ppx = .RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72: End With
    ExtraitXML = Replace(cel.Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")
    texte = Split(Split(Replace(ExtraitXML, "html:", ""), "<Data")(1), "</Data")(0)
    texte = Replace(texte, Split(texte, ">")(0) & ">", "")
    If IsDate(cel.Value) Then texte = cel.Text    'Format(cel.Text, "dd/mm/yyyy")
    fcolor = Split(ExtraitXML, "ss:FontName="""): i = 1
    If Not IsNull(cel.Font.Color) And cel.Font.Color <> 0 Then i = 2
    fontcolor = Split(Split(fcolor(i), "ss:Color=""")(1), Chr(34))(0)
    font_size = Split(Split(fcolor(UBound(fcolor)), "ss:Size=""")(1), Chr(34))(0)
    font_name = Split(fcolor(UBound(fcolor)), Chr(34))(0)
      Set fonte = doc.createelement("FONT")
    With fonte: .Style.Color = fontcolor: .Style.FontSize = font_size * ppx: .face = font_name: .innerhtml = texte
        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
    End With
    text_stylé = fonte.outerhtml
End Function

en gros je veux insérer le code directement dans l'object pour faire la même chose

en espérant avoir été plus clair

[Invité]

Bonjour Patrick,

Code :

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

1
2
3
4
5
with creatobject("MSXML2.DOMDocument")
    If Not .LoadXML(range("A1").value(xlRangeValueXMLSpreadsheet)) Then
        Err.Raise .parseError.ErrorCode, , .parseError.reason
    End If
End with

[patricktoulon]

re

bon ben voila
".loadxml"
avec gestion d'erreur en plus

merci robert

c'est quand même plus simple pour récupérer des données

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
    Set docxml = CreateObject("MSXML2.DOMDocument")
    'Debug.Print Range("b3").Value(xlRangeValueXMLSpreadsheet)
        With docxml
        '.LoadXML (Replace(Range("B3:c4").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data"))' ca marche aussi sans gestion d'erreur
        If Not .LoadXML(Replace(Range("B3:c4").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then err.Raise .parseError.ErrorCode, , .parseError.reason
 
        ' innerhtml de la cellule
        Set onode = docxml.SelectSingleNode("/Workbook/Worksheet/Table/Row/Cell/Data")
        Debug.Print onode.BaseName & " " & Trim(Replace(onode.XML, Split(onode.XML, ">")(0) & ">", ""))
        'MsgBox docxml.XML
    End With
End Sub

j'aurrais besoins de toi robert si tu veux bien
pour récupéer non pas les node text mais les attributs ca je sais pas faire en XML
exemple ce qui est en rouge

Code :

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

1
2
<Border ss:Position="Right" ss:LineStyle="Dash" ss:Weight="2"
     ss:Color="#00B050"/>

[Invité]

Bonjour Patrick,

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
Sub test()
    Set docxml = CreateObject("MSXML2.DOMDocument")
        With docxml
        If Not .LoadXML(Replace(Range("B1:c10").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then Err.Raise .parseError.ErrorCode, , .parseError.reason
         Set Attrs = docxml.SelectSingleNode("/Workbook/Worksheet/Table").Attributes
        For Each Lignes In docxml.SelectSingleNode("/Workbook/Worksheet/Table").ChildNodes
            For Each colonnes In Lignes.ChildNodes
                Debug.Print colonnes.Text
                For Each Att In colonnes.Attributes
                  Debug.Print Att.Text
                Next
            Next
        Next
        Debug.Print onode.BaseName & " " & Trim(Replace(onode.XML, Split(onode.XML, ">")(0) & ">", ""))
    End With
End Sub

[pijaku]

Bonjour Patrick,

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 Test()
Dim docxml As Variant
Dim Noeud As Variant
Dim Attribu As Variant
Dim Attributs() As String, i As Long
 
    Set docxml = CreateObject("MSXML2.DOMDocument")
    With docxml
        If Not .LoadXML(Replace(Range("B3:c4").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then Err.Raise .parseError.ErrorCode, , .parseError.reason
        Set Noeud = .SelectSingleNode("/Workbook/Worksheet/Table")
        If Not Noeud Is Nothing Then
            For Each Attribu In Noeud.Attributes
                ReDim Preserve Attributs(i)
                Attributs(i) = Attribu.BaseName & " := " & Attribu.Value 'Value ou Text, comme tu veux...
                i = i + 1
            Next
        End If
    End With
    MsgBox Join(Attributs, vbCrLf)
End Sub

EDIT : Un petit conseil @Patrick...
Lorsque tu travailles sur un objet de ce type, même si, in fine tu utiliseras CreateObject, commences par travailler avec la library concernée.
Ainsi, en cochant la référence XML 6.0 tu as accès à l'intellisence ET à l'aide VBA.
Aide VBA qui t'aurais apporté ceci :

Property attributes As IXMLDOMNamedNodeMap
Lecture seule
Membre de MSXML2.DOMDocument
the collection of the node's attributes

Ensuite, en travaillant toujours avec cette library, tu développes ton code, en déclarant TOUTES les variables, 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
Option Explicit
 
Public Sub test()
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
        If Not .LoadXML(Replace(Range("B3:c4").Value(xlRangeValueXMLSpreadsheet), "ss:Data", "Data")) Then Err.Raise .parseError.ErrorCode, , .parseError.reason
        Set Noeud = .SelectSingleNode("/Workbook/Worksheet/Table")
        If Not Noeud Is Nothing Then
            Set Attributs = Noeud.Attributes
            For Each A In Attributs
                Debug.Print A.BaseName & " := " & A.Value 'Value ou Text, comme tu veux...
            Next
        End If
    End With
End Sub

Et si, enfin, tu ne souhaites pas obliger l'utilisateur à cocher la référence, tu transformes le code comme je te l'ai livré en premier, avec des Variant.....

[patricktoulon]

re
Bonjour pijaku
c'est vrai en earlybinding j'aurais l'intelligence il est vrai que j'ai l'habitude inverse "latebinding"
je vais regarder la propriété "map"
merci

[Invité]

Pour compléter les remarques de pijaku, il m'arrive de faire ça

Code :

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

1
2
dim docxml as MSXML2.DOMDocument
Set docxml = CreateObject("MSXML2.DOMDocument")

Ensuite pour la prod je décoche la référence et je mets as Object!

J'utilise surtout l'espion

[patricktoulon]

re
bonjour robert

une derniere question avant de cloturer
est on obligé de boucler pou chopper x élément de même tag ?????

j'ai deux elements qui ont le chemin

/Workbook/Styles/Style/Font")

chaque "font "est dans une balise"style" diffèrent autrement pour l'exemple
j'ai
le 1er pour les paramètre par défaut
le 2d pour les paramètres actuels

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
<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">
            <Font ss:FontName="Aharoni" x:CharSet="177" ss:Size="16" ss:Color="#FF0000"/>
            <Interior/>
        </Style>
    </Styles>

[pijaku]

Ta réponse, Patrick, m'amène à penser, peut être à tort, que tu n'as pas tenu compte de mes conseils. Tout est dans l'aide VBA sur la library XML 6.0...

[patricktoulon]

ho oui comme j'aimerais un peu d'aide


quand a l'aide comment dire heu .......

en gros la fenêtre des définition pour moi c'est mort et l'aide est tellement succincte que si j'avais un p... de moyen de faire sauter ce point d'interrogation dans ma barre je ne me priverais pas
*voila ou j'en suis

[Invité]

Oui et non, mais il faut savoir que l'id du style et dans le nodes enfant!
colonnes.Attributes

[pijaku]

Patrick,

Il n'y a pas que le point d'interrogation qui t'apporte de l'aide.
Aide toi et VBA t'aideras petit padawan...

Avec ton niveau de connaissances, l'explorateur d'objet, dans lequel tu sélectionnes la bonne library, te donnes toutes les méthodes des objets choisis.

Ainsi, pour ta question, tu aurais trouvé :

Function getElementsByTagName(tagName As String) As IXMLDOMNodeList
Membre de MSXML2.IXMLDOMElement
build a list of elements by name

ainsi que :

Function getAttribute(name As String)
Membre de MSXML2.IXMLDOMElement
look up the string value of an attribute by name

et ainsi pondu tout seul 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
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
 
    With docxml
        If Not .LoadXML(Replace(Range("B3:c4").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"
        If Not Noeuds Is Nothing Then
            'boucle sur les noeuds appelés "Font"
            For Each E In Noeuds
                'retourne leur attribut nommé ss:FontName
                vOut = E.getAttribute(vIn)
                Debug.Print vOut
            Next
        End If
    End With
    Set docxml = Nothing
    Set Noeuds = Nothing
End Sub

[patricktoulon]

Bonjour pijaku

Bonjour Pijaku

je te jure sur ce que j'ai de plus cher au monde que j'avais essayé ".getattribute" et "getelementsbytagname"c'est exactement le même principe qu'en HTML
d'ailleurs autrefois sur des fichier Xml anciens je m'en servais
sur ces xml ca n'a rien donné je vais re tester peu être ai-je zapper quelque chose

[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