Sub creerFichierXML()
'
'Nécessite d'activer la référence "Microsoft XML, V..."
'
Dim objDOM As DOMDocument
Dim XnodeRoot As IXMLDOMElement
Dim oNode As IXMLDOMNode, XInfos As IXMLDOMNode
Dim XNom As IXMLDOMElement
Dim Cmt As IXMLDOMComment
Set objDOM = New DOMDocument
'Ajout d'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))
'entête
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("Participants")
objDOM.appendChild XnodeRoot
Set XNom = objDOM.createElement("Participant")
XNom.setAttribute "Nom", "Riri"
XnodeRoot.appendChild XNom
Set XInfos = objDOM.createElement("Ville")
XInfos.Text = "Ville 01"
XNom.appendChild XInfos
Set XInfos = objDOM.createElement("DateNaissance")
XInfos.Text = #5/26/1965#
XNom.appendChild XInfos
Set XInfos = objDOM.createElement("Credits")
XInfos.Text = 3
XNom.appendChild XInfos
Set XNom = objDOM.createElement("Participant")
XNom.setAttribute "Nom", "Fifi"
XnodeRoot.appendChild XNom
Set XInfos = objDOM.createElement("Ville")
XInfos.Text = "Ville 02"
XNom.appendChild XInfos
Set XInfos = objDOM.createElement("DateNaissance")
XInfos.Text = #2/14/1970#
XNom.appendChild XInfos
Set XInfos = objDOM.createElement("Credits")
XInfos.Text = 7
XNom.appendChild XInfos
objDOM.Save "C:\Nom Fichier.xml"
Set XnodeRoot = Nothing
Set objDOM = Nothing
End Sub
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("B3: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
"erreur d'execution '9'
L'indice n'apartient pas à la sélection
Vraissemblablement à ce niveau :
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:F7")
End Sub
Bien que le résultat en erreur soit identique où que soit le curseur !