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
| Sub test2xml()
Dim Doc_XML As Object 'Va nous permettre de créer le XML
Dim Root As Object '... de créer la racine du XML
Dim Node As Object '... de créer les noeuds
Dim Name As Object '... de créer les attributs
Dim Chemin As String 'Chemin de sauvegarde
Set Doc_XML = CreateObject("MSXML2.DOMDocument") 'Création du XML
'Ajout des données d'encodage/etc...
Set Node = Doc_XML.createProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")
Doc_XML.appendChild Node 'Ajout des données au fichier
Set Node = Nothing 'Remise à zéro du noeud
Set Root = Doc_XML.createElement("Root") 'Création d'une racine
Doc_XML.appendChild Root 'Ajout de la racine au XML
Set Node = Doc_XML.createElement("Child55") 'Création d'un noeud
Root.appendChild Node 'Ajout du noeud à la racine
Node.Text = "Text 1" 'Ajout d'un texte dans le noeud
Set Node = Nothing
Dim Plage As Range
Dim Nm As Name
On Error Resume Next
'Boucle sur les noms du classeur
For Each Nm In ThisWorkbook.Names
Set Plage = Nm.RefersToRange
If Not Plage Is Nothing Then
'Vérifie si le nom appartient à la feuille
If Worksheets("T06").Name = Plage.Worksheet.Name Then _
Node = Doc_XML.createElement("ValeurCellule") 'Création d'un noeud
Root.appendChild Node 'Ajout du noeud à la racine
Node.Text = Nm.Name
Set Node = Nothing
End If
Set Plage = Nothing
Next Nm
'Sauvegarde
Chemin = ThisWorkbook.Path & "\Nom du Fichier.xml" 'Chemin de sauvegarde + Nom du fichier
Doc_XML.Save Chemin
End Sub |
Partager