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

ThisWorkbook.XmlMaps(1).DataBinding.Refresh

ThisWorkbook.XmlMaps("développez_Mappage").DataBinding.Refresh

Workbooks.OpenXML Filename:= _
    "C:\dossier\NomFichier.xml", _
    LoadOption:=xlXmlLoadImportToList