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

Version imprimable

1 pièce(s) jointe(s)

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:

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 !

1 pièce(s) jointe(s)

Commençons par la base : A lire ! :mouarf:

Ensuite plusieurs étapes interviennent :

Création du doc XML

Code:

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:

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:

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:

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:

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

Résultat :
Pièce jointe 280671

En espérant t'avoir aidé :mrgreen:

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:

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:

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 !

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 :mouarf:
Code:

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:

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
Bon courage :mrgreen:

EDIT :
Pour aller plus vite si toutes tes données se suivent tu peux utiliser des boucles For ... Next et des With

02/06/2017, 09h27
PythonNovices

Bonjour,

Merci beaucoup pour vos réponses.

Cordialement,