Générer un fichier xml via une macro Excel

**PythonNovices** · 29/05/2017, 13h40

Bonjour,

J'ai un fichier données au format Excel. Je souhaite transformer les données dans un fichier xml automatiquement via une macro Excel.

Voici le squelette du fichier xml:

Code xml :

Sélectionner tout - Visualiser dans une fenêtre à part

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
<?xml version="1.0" standalone="yes"?>
<List xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://tempuri.org/List.xsd">
  <Info>
    <Publish_Date>26/05/2017</Publish_Date>
    <Record_Count>1</Record_Count>
  </Info>
  <Ident>
    <firstName>toto01</firstName>
    <lastName>Dupont01</lastName>
    <title>ingénieur</title>
    <sdnType>Individual</sdnType>
    <nationalityList>
      <nationality>
        <country>France</country>
      </nationality>
    </nationalityList>
    <dateOfBirthList>
      <dateOfBirthItem>
        <dateOfBirth>01 Jul 1990</dateOfBirth>
      </dateOfBirthItem>
    </dateOfBirthList>
    <placeOfBirthList>
      <placeOfBirthItem>
        <placeOfBirth>Paris France</placeOfBirth>
      </placeOfBirthItem>
    </placeOfBirthList>
  </Ident>
</List>

En pièce jointe le fichier Excel. L'entete du fichier ne change pas.

Merci de votre aide. Je n'ai pas une idée comment le mettre en place.

Merci beaucoup !

**Al__22** · 30/05/2017, 11h44

Commençons par la base : A lire !

Ensuite plusieurs étapes interviennent :

Création du doc XML

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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=""ISO-8859-1""")
 
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

Ajouter un noeud

1re solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Set Node = Doc_XML.CreateElement("Child1")         'Création d'un noeud
Root.appendChild Node                               'Ajout du noeud à la racine
Node.Text = "Text 1"                                'Ajout d'un texte dans le noeud
 
'Ajout de la partie attribut si tu le souhaite
 
Set Node = Nothing                                  'Remise à zéro du noeud
'... etc pour chaque noeud

2e solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
'Ajout d'un noeud
With Root.appendChild(Doc_XML.CreateElement("Child10"))
 
    .Text = "Text 10"                               'Ajout du texte
End With
'... etc pour chaque noeud

Ajouter un attribu au noeud

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set Name = Doc_XML.CreateAttribute("Attrib")        'Création de l'attribut
Name.NodeValue = "Ce que tu veux"                   'Nommnation de l'attribut
Node.SetAttributeNode Name                          'Ajout de l'attribut au noeud

Sauvegarder le XML

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Chemin = ThisWorkbook.Path & "\Nom du Fichier.xml"  'Chemin de sauvegarde + Nom du fichier
Doc_XML.Save Chemin                                 'Sauvegarde

Résultat :
Nom : Capture.JPG
Affichages : 6744
Taille : 18,4 Ko

En espérant t'avoir aidé

**PythonNovices** · 30/05/2017, 16h11

Bonjour,

Merci beaucoup Al__22 pour votre répondre très claire et précis.

J'ai quelques questions supplémentaires :
* Comment faire récupérer les données depuis une feuilles Excel au lieu de les mettre en dur (pour que valeur d'une cellule soit dans une balise.)?
* Est-il possible de faire un retour chariot après chaque balise ?
*

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Text()
 
    Dim Fichier As Object 
    Dim XmlBalise As Object
    Dim Node As Object
    Dim Toto As Object
    Dim Titi As Object
    Dim Tata As Object
 
 
	Dim Chemin As String
	Set Fichier = CreateObject("MSXML2.DOMDocument")
    Set Node = Fichier.CreateProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""")
 
    Fichier.appendChild Node
    Set Node = Nothing
 
    Set XmlBalise = Fichier.CreateElement("XmlBalise")
    Fichier.appendChild XmlBalise
    Set Toto = Fichier.CreateElement("Toto")
    XmlBalise.appendChild Toto
    Toto.Text = "Valeur01"
    Set Titi = Fichier.CreateElement("Titi")
    XmlBalise.appendChild Titi
    Titi.Text = "Valeur02"
    Set Tata = Fichier.CreateElement("Tata")
    XmlBalise.appendChild Tata
    Tata.Text = "Valeur03"
 
    Set Node = Nothing
 
    Chemin = ThisWorkbook.Path & "\FichierSorti.xml"
    Fichier.Save Chemin
 
End Sub

Code xml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
<?xml version="1.0" encoding="UTF-8"?>
<XmlBalise>
	<Toto>Valeur01</Toto>
	<Titi>Valeur02</Titi>
	<Tata>Valeur03</Tata>
	<Toto>Valeur04</Toto>
	<Titi>London</Titi>
	<Tata>USA</Tata>
	<Toto>Belgique</Toto>
	<Titi>Paris</Titi>
	<Tata>France</Tata>
</XmlBalise>

Merci beaucoup pour vos réponses !

**Al__22** · 30/05/2017, 16h42

Pour ce qui est des retours chariots ou des tabulations il suffit de rajouter un nœud du même type avant ou après les données souhaitées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
   Root.appendChild Doc_XML.createTextNode(vbCrLf) 'Retour
   Root.appendChild Doc_XML.createTextNode(vbTab) 'Tabulation

Pour récupérer les données de la feuille Excel il suffit de changer les "Nom" de tes noeuds ou les "Texte" de ceux-ci par Sheets("Ta feuille").Range("Cellule où est/sont les données").Value
Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
With Sheets("Données")
Set Node = Doc_XML.CreateElement(.Range("A1").Value)
Root.appendChild Node
Node.Text = .Range("B1").Value
 
Set Node = Doc_XML.CreateElement(.Range("A2").Value)
Root.appendChild Node
Node.Text = .Range("B2").Value
 
'... etc
 
Set Node = Nothing
End With