Option Explicit

Dim objDOM As DOMDocument


Sub Test()
    'Définit la plage de cellules qui va servir pour la création du
    'fichier xml.
    'La première ligne du tableau est supposée contenir les entêtes
    '(sans espaces ni caractères spéciaux).
    CreationFichierXML Worksheets("Feuil1").Range("A1:F20")

End Sub



Sub CreationFichierXML(Plage As Range)
'
'Nécessite d'activer la référence "Microsoft XML, V..."
'
Dim XnodeRoot As IXMLDOMElement, oNode As IXMLDOMNode
Dim XNom As IXMLDOMElement
Dim Cmt As IXMLDOMComment
Dim Entete As Range, Cell As Range
Dim i As Integer, j As Integer


Set Entete = Plage.Rows(1)
Set Plage = Plage.Offset(1, 0).Resize(Plage.Rows.Count - 1, Plage.Columns.Count)


'----
Set objDOM = New DOMDocument

'Ajoute un commentaire qui reprend le nom de l'utilisateur et
' la date du jour.
Set Cmt = objDOM.createComment("Créé par " & Environ("username") & ", le " & Date)
Set Cmt = objDOM.InsertBefore(Cmt, objDOM.ChildNodes.Item(0))
    
'Type de fichier
Set oNode = objDOM.createProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
Set oNode = objDOM.InsertBefore(oNode, objDOM.ChildNodes.Item(0))
'----

    
Set XnodeRoot = objDOM.createElement("MonTableau")
objDOM.appendChild XnodeRoot

'Boucle sur les données du tableau
For j = 1 To Plage.Rows.Count

    Set XNom = objDOM.createElement("DonneeTableau")
    XNom.setAttribute Entete.Cells(1, 1), Plage.Cells(j, 1)
    XnodeRoot.appendChild XNom
        
    For i = 2 To Entete.Columns.Count
        CreationElement Entete.Cells(1, i), Plage.Cells(j, i), XNom
    Next i
Next j


objDOM.Save "C:\Nom Fichier.xml"

Set XnodeRoot = Nothing
Set objDOM = Nothing
End Sub



Sub CreationElement(strElem As String, Donnee As Variant, oNom As IXMLDOMElement)
    Dim XInfos As IXMLDOMNode

    Set XInfos = objDOM.createElement(strElem)
    XInfos.Text = Donnee
    oNom.appendChild XInfos

End Sub

Sub ImporterFichierXML()
    Dim XM As XmlMap
    
    'Importe le fichier dans la cellule B1 de la Feuil3.
    ThisWorkbook.XmlImport _
        URL:="C:\Nom Fichier.xml", _
        ImportMap:=Nothing, _
        Overwrite:=True, _
        Destination:=Worksheets("Feuil3").Range("$B$1")
    
    'Définit le mappage qui vient d'être ajouté.
    'ThisWorkbook.XmlMaps.Count correspond au dernier xml mappé dans le classeur
    Set XM = ThisWorkbook.XmlMaps(ThisWorkbook.XmlMaps.Count)
    
    
    MsgBox "Import terminé" & vbCrLf & _
        XM.RootElementName & vbCrLf & _
        XM.Name & vbCrLf & _
        XM.DataBinding.SourceUrl
    
End Sub

Sub SuppressionMappage()
    'La suppression est effectuée  à partir du nom de l'élément parent.
    ThisWorkbook.XmlMaps("MesDonnees_Mappage").Delete
    
    'Ou en utilisant son numéro d'index
    'ThisWorkbook.XmlMaps(1).Delete
    
    'Nota:
    'Le mappage est supprimé mais les données sont conservées dans la feuille, sous
    'forme de tableau.
    
End Sub

Private Sub Workbook_AfterXmlImport(ByVal Map As XmlMap, ByVal IsRefresh As Boolean, _
    ByVal Result As XlXmlImportResult)
    
    MsgBox IsRefresh & vbCrLf & _
        Map.Name 
End Sub

Option Explicit
Dim oDoc As MSXML2.DOMDocument


Private Sub CommandButton1_Click()
    Set oDoc = New DOMDocument
    
    oDoc.async = False
    oDoc.Load "C:\NomFichier.xml"
    
    TreeView1.Nodes.Clear
    AddNode oDoc.DocumentElement
End Sub

Private Function AddNode(ByRef oElem As MSXML2.IXMLDOMNode, _
        Optional ByRef oTreeNode As MSComctlLib.Node)
    Dim oNewNode As MSComctlLib.Node
    Dim oNodeList As MSXML2.IXMLDOMNodeList
    Dim i As Long
      
    If oTreeNode Is Nothing Then
        Set oNewNode = TreeView1.Nodes.Add  'Creation du noeud racine
        oNewNode.Expanded = True
        Else
        Set oNewNode = TreeView1.Nodes.Add(oTreeNode, tvwChild) 'Ajout d'un noeud enfant
        oNewNode.Expanded = True
    End If
      
    Select Case oElem.NodeType
        Case MSXML2.NODE_ELEMENT 'type Element
        oNewNode.Text = oElem.nodeName & " (" & GetAttributes(oElem) & ")"
        Set oNewNode.Tag = oElem
        
        Case MSXML2.NODE_TEXT 'type texte
        oNewNode.Text = "Text: " & oElem.NodeValue
        Set oNewNode.Tag = oElem
        
        Case 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
        AddNode oNodeList.Item(i), oNewNode
    Next i
End Function

Private Function GetAttributes(ByRef oElm As MSXML2.IXMLDOMNode) As String
    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
    
    GetAttributes = sAttr
End Function