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