Charger un nœud XML complet spécifique dans un arbre TreeView en VBA Excel
Bonjour,
Je bute sur un problème depuis quelques temps, sans arriver à trouver de solution...
Je parts du chargement d'un fichier XML très lourd, dont j'affiche la liste de tous les noms de noeuds de premier niveau dans une ListBox (ListBoxCollections).
Je cherche à afficher dans une TreeView (TreeViewXML) non pas tout le XML du fichier chargé, mais uniquement la branche de nom de noeud sélectionné.
En lançant la macro, une incompatibilité de type s'affiche lors de l'ajout du noeud dans le TreeView. Dans le code ParseColPourTreeViewXML, le noeud trouvé TVCol est un MSXML2.IXMLDOMNodeList, alors que dans le code AddXMLnode, TVCol (oTreeNode) est transmis en tant que MSComctlLib.Node. Comment faire pour transmettre TVCol à TreeView ?
Voilà le code de la procédure évènementielle qui doit lancer sur le TreeView l'affichage spécifique de la branche de nom de noeud sélectionné dans la ListBox:
Code:
1
2
3
4
5
6
|
Private Sub ListBoxCollections_Click()
Me.TreeViewXML.Nodes.Clear
Call FillTreeViewXMLonListBoxColSelection("monFichierXML.xml", Me.ListBoxCollections.Value)
Me.TreeViewXML.Refresh
End Sub |
Voilà le code de remplissage et d'affichage du TreeView sur la sélection transmise (Ne marche pas ):
Code:
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
|
Private Sub FillTreeViewXMLonListBoxColSelection(NomFichier As String, NomCollection As String)
' Nécessite la référence MSXML2.DOMDocument.6.0 ssi méthode par New MSXML2.DOMDocument60.
' Pas de référence à préciser ssi méthode CreateObject("MSXML2.DOMDocument.6.0") choisie !
' Affiche le noeud complet TVCol du nom de la collection NomCollection parsée dans le Dataset
Dim XMLdoc As Object ' As MSXML2.DOMDocument60
Dim strErrText As String
Dim xPE As Object ' As MSXML2.IXMLDOMParseError
Dim TVCol As Object ' ' As MSComctlLib.Node
Dim i As Long
' Instanciation du parseur
'Set XMLdoc = New MSXML2.DOMDocument60 ' doit être défini en référence MSXML, V6.0
Set XMLdoc = CreateObject("MSXML2.DOMDocument.6.0") ' association de l'objet avec la dll
' La validation du document est inhibée (on suppose que c'est bon!)
XMLdoc.validateOnParse = False
' Chargement du document XML
If XMLdoc.Load(NomFichier) Then
' Le document a été chargé avec succès.
' L'analyse peut débuter...
' Récupération du noeud portant le nom de la collection transmise
Set TVCol = XMLdoc.SelectNodes("//*[local-name(.)='" & NomCollection & "']")
' Remplissage de l'arbre XML dans TreeViewXML avec le noeud TVCol
Call AddXMLnode(XMLdoc, TVCol)
Else
' Impossible de charger le document
' Obtient l'objet ParseError
Set xPE = XMLdoc.parseError
With xPE
strErrText = "Your XML Document failed to load " & "due the following error." & vbCrLf & _
"Error #: " & .ErrorCode & ": " & xPE.reason & "Line #: " & .Line & vbCrLf & _
"Line Position: " & .linepos & vbCrLf & _
"Position In File: " & .filepos & vbCrLf & _
"Source Text: " & .srcText & vbCrLf & _
"Document URL: " & .URL
End With
MsgBox strErrText, vbExclamation
End If
' Libération de la mémoire
Set XMLdoc = Nothing
Set xPE = Nothing
Set TVCol = Nothing
End Sub |
Le reste du code est issu d'une méthode trouvée sur le net, appartenant à SilkyRoad (http://excel.developpez.com/faq/?page=XML), que j'ai adapté (sans succès) pour ma compilation...
Code:
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
|
Public Sub AddXMLnode(ByRef oElem As Object, Optional ByRef oTreeNode As Object)
' oElem As MSXML2.IXMLDOMNode
' oTreeNode as object 'As MSComctlLib.Node
Dim XMLdoc As Object ' As MSXML2.DOMDocument60
Dim oNewNode As Object ' As MSComctlLib.Node
Dim oNodeList As Object ' As MSXML2.IXMLDOMNodeList
Dim i As Long
If oTreeNode Is Nothing Then
Set oNewNode = TreeViewXML.Nodes.Add 'Creation du noeud racine
oNewNode.Expanded = True
Else
Set oNewNode = Me.TreeViewXML.Nodes.Add(oTreeNode, tvwChild) 'Ajout d'un noeud enfant
oNewNode.Expanded = True
End If
Select Case oElem.NodeType
Case 1 ' MSXML2.NODE_ELEMENT 'type Element
oNewNode.Text = oElem.nodeName & " (" & GetXMLattributes(oElem) & ")"
Set oNewNode.Tag = oElem
Case 3 ' MSXML2.NODE_TEXT 'type texte
oNewNode.Text = "Text: " & oElem.NodeValue
Set oNewNode.Tag = oElem
Case 4 ' MSXML2.NODE_CDATA_SECTION 'type Cdata
oNewNode.Text = "CDATA: " & oElem.NodeValue
Set oNewNode.Tag = oElem
Case Else
oNewNode.Text = oElem.NodeType & ": " & oElem.nodeName
Set oNewNode.Tag = oElem
End Select
Set oNodeList = oElem.ChildNodes 'boucle récursive pour ajouter tous les noeuds enfants
For i = 0 To oNodeList.Length - 1
Call AddXMLnode(oNodeList.Item(i), oNewNode)
Next i
End Sub
Private Function GetXMLattributes(ByRef oElm As Object) As String
' oElm As MSXML2.IXMLDOMNode
Dim sAttr As String
Dim i As Long
sAttr = ""
For i = 0 To oElm.Attributes.Length - 1 'boucle sur tous les attributs
sAttr = sAttr & oElm.Attributes.Item(i).nodeName & "='" & _
oElm.Attributes.Item(i).NodeValue & "' "
Next i
GetXMLattributes = sAttr
End Function |
