Autres Mapper fichier XML dans Excel avec TLE

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion FS69
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
F

FS69

XLDnaute Nouveau
Bonjour,

Je suis un novice en XML et Excel aussi, je dois constituer un fichier csv basé sur un XML afin de faire correspondre les données du XML dans la colonne/position attendue.

Le fichier XML contient des "name" et des "value". chaque "name" à une "value" associée et séparé par un "TLE"

Comment puis je faire pour que chaque "name" puisse être identifiée comme une zone de mappage et qu'ainsi les "value" soient positionnées

1722870633485.png

1722871148470.png
 
Solution
patricktoulon
re
c'est pas une ligne qu'il faut changer
on garde le moteur on met un carbu double corps on remplace les cable par l'hydrolique
on modifie un peu ici et là
on la transform en fonction
on ajoute une sub de pilotage (grand guidon)
😀
choisi le dossier dans la boite de dialogue
VB: 
Sub test()
    Dim sfolder$, fichier, header$, y&, file$
    fichier = ThisWorkbook.Path & "\compilation.csv"
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sfolder = .SelectedItems(1)
            Else: Exit Sub
        End If
    End With
    header = "NumeroCient;NumeroContrat;NumeroSinistre;Identifiant Unique document;Code Maquette;Date de creation Document;Civilité;Nom;Prenom;" & _...
Trier par date Trier par votes
re
ceci devrait faire l'affaire
j'ai ajouté la boite de dialog selection de fichier vous n'aurez pas a changer dans le code comme ça
on pourrait aussi adapter avec un dossier et lui faire faire tout les xml a la suite en un coup
VB: 
Sub test()
    Dim T, NodeDoc, Nodexs As Object, x&, header, tabhead, tb$(), i, myfile$, myfileCsV$
    header = "NumeroCient;NumeroContrat;NumeroSinistre;Identifiant Unique document;Code Maquette;Date de creation Document;Civilité;Nom;Prenom;" & _
              "branche;famille;Sous famille;Sous Famille2;Libellé Produit;Univers;sendflux;sourceged;libelléstatut;docencrys;" & _
              "IDAQUISIT;IDAQUISIT;IDAQUISIT;Chemin d'acces au fichier"
    tabhead = Split(header, ";")

    myfile = Application.GetOpenFilename("XML Files (*.xml), *.xml", 1, "ouvrir un fichier xml")
     If myfile = "Faux" Then Exit Sub

    myfileCsV = Replace(myfile, ".xml", ".csv")

    With CreateObject("microsoft.xmldom")
        .Load myfile
        Set NodeDoc = .getelementsbytagname("Document")
        For i = 0 To NodeDoc.Length - 1
            ReDim tb(UBound(tabhead)) ' t = t & Nodexs(i).Text & ":" & vbTab & Nodexs(i).NextSibling.Text & vbCrLf
            tb(UBound(tb)) = NodeDoc(i).ChildNodes(0).Text

            Set Nodexs = NodeDoc(i).getelementsbytagname("Name")
            For a = 0 To Nodexs.Length - 1
                Select Case Nodexs(a).Text
                    Case "datedoc": tb(5) = Nodexs(a).NextSibling.Text
                    Case "numadh": tb(1) = Nodexs(a).NextSibling.Text
                    Case "numcli": tb(0) = Nodexs(a).NextSibling.Text
                    Case "cciv": tb(6) = Nodexs(a).NextSibling.Text
                    Case "nom1": tb(8) = Nodexs(a).NextSibling.Text
                    Case "nom2": tb(7) = Nodexs(a).NextSibling.Text
                    Case "cetat": tb(4) = Nodexs(a).NextSibling.Text
                End Select

            Next
            T = T & Join(tb, ";") & vbCrLf
        Next
    End With
    T = header & vbCrLf & T
    x = FreeFile: Open myfileCsV For Output As #x: Print #x, T: Close #x
    MsgBox "votre fichier xml a été converti"
End Sub
testé avec ton dernier fichier xml de ton archive
 
Vote positif 0 Vote négatif
re
normalement si le xml avait été bien fait ou mieux fait ça aurait été
Code: 
 Case "datedoc": tb(5) = Nodexs(a).ChildNodes(0).text
                    Case "numadh": tb(1) = Nodexs(a).ChildNodes(0).text
                    Case "numcli": tb(0) = Nodexs(a).ChildNodes(0).text
                    Case "cciv": tb(6) = Nodexs(a).ChildNodes(0).text
                    Case "nom1": tb(8) = Nodexs(a).ChildNodes(0).text
                    Case "nom2": tb(7) = Nodexs(a).ChildNodes(0).text
                    Case "cetat": tb(4) = Nodexs(a).ChildNodes(0).text
 
Vote positif 0 Vote négatif
patricktoulon à dit:
re
ceci devrait faire l'affaire
j'ai ajouté la boite de dialog selection de fichier vous n'aurez pas a changer dans le code comme ça
on pourrait aussi adapter avec un dossier et lui faire faire tout les xml a la suite en un coup
VB: 
Sub test()
    Dim T, NodeDoc, Nodexs As Object, x&, header, tabhead, tb$(), i, myfile$, myfileCsV$
    header = "NumeroCient;NumeroContrat;NumeroSinistre;Identifiant Unique document;Code Maquette;Date de creation Document;Civilité;Nom;Prenom;" & _
              "branche;famille;Sous famille;Sous Famille2;Libellé Produit;Univers;sendflux;sourceged;libelléstatut;docencrys;" & _
              "IDAQUISIT;IDAQUISIT;IDAQUISIT;Chemin d'acces au fichier"
    tabhead = Split(header, ";")

    myfile = Application.GetOpenFilename("XML Files (*.xml), *.xml", 1, "ouvrir un fichier xml")
     If myfile = "Faux" Then Exit Sub

    myfileCsV = Replace(myfile, ".xml", ".csv")

    With CreateObject("microsoft.xmldom")
        .Load myfile
        Set NodeDoc = .getelementsbytagname("Document")
        For i = 0 To NodeDoc.Length - 1
            ReDim tb(UBound(tabhead)) ' t = t & Nodexs(i).Text & ":" & vbTab & Nodexs(i).NextSibling.Text & vbCrLf
            tb(UBound(tb)) = NodeDoc(i).ChildNodes(0).Text

            Set Nodexs = NodeDoc(i).getelementsbytagname("Name")
            For a = 0 To Nodexs.Length - 1
                Select Case Nodexs(a).Text
                    Case "datedoc": tb(5) = Nodexs(a).NextSibling.Text
                    Case "numadh": tb(1) = Nodexs(a).NextSibling.Text
                    Case "numcli": tb(0) = Nodexs(a).NextSibling.Text
                    Case "cciv": tb(6) = Nodexs(a).NextSibling.Text
                    Case "nom1": tb(8) = Nodexs(a).NextSibling.Text
                    Case "nom2": tb(7) = Nodexs(a).NextSibling.Text
                    Case "cetat": tb(4) = Nodexs(a).NextSibling.Text
                End Select

            Next
            T = T & Join(tb, ";") & vbCrLf
        Next
    End With
    T = header & vbCrLf & T
    x = FreeFile: Open myfileCsV For Output As #x: Print #x, T: Close #x
    MsgBox "votre fichier xml a été converti"
End Sub
testé avec ton dernier fichier xml de ton archive
Cliquez pour agrandir...
Un seul mot : MERCI !

Si j'abuse un peu (beaucoup) est ce possible d'avoir la ligne de commande pour ouvrir les XML présents dans un dossier et un seul csv ?

Si vous ne pouvez pas aucun soucis vous m'avez déjà énormément aidé !
 
Vote positif 0 Vote négatif
re
c'est pas une ligne qu'il faut changer
on garde le moteur on met un carbu double corps on remplace les cable par l'hydrolique
on modifie un peu ici et là
on la transform en fonction
on ajoute une sub de pilotage (grand guidon)
😀
choisi le dossier dans la boite de dialogue
VB: 
Sub test()
    Dim sfolder$, fichier, header$, y&, file$
    fichier = ThisWorkbook.Path & "\compilation.csv"
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sfolder = .SelectedItems(1)
            Else: Exit Sub
        End If
    End With
    header = "NumeroCient;NumeroContrat;NumeroSinistre;Identifiant Unique document;Code Maquette;Date de creation Document;Civilité;Nom;Prenom;" & _
              "branche;famille;Sous famille;Sous Famille2;Libellé Produit;Univers;sendflux;sourceged;libelléstatut;docencrys;" & _
              "IDAQUISIT;IDAQUISIT;IDAQUISIT;Chemin d'acces au fichier"
    y = FreeFile: Open fichier For Output As #y: Print #y, header: Close #y
    NbCol = UBound(Split(header, ";"))

    file = Dir(sfolder & "\*.xml")
    Do While file <> ""
        ok = mangetout(sfolder & "\" & file, fichier, NbCol)
       ' MsgBox file
        Do While a = 500: DoEvents: a = a + 1: Loop
        DoEvents
        file = Dir()
    Loop
    MsgBox "votre compilation en csv est prête "


End Sub

Function mangetout(myfile, compilcsv, NbCol)
    Dim T, NodeDoc, Nodexs As Object, x&, header, tabhead, tb$(), i

    With CreateObject("microsoft.xmldom")
        .Load myfile
        Set NodeDoc = .getelementsbytagname("Document")
        For i = 0 To NodeDoc.Length - 1
            ReDim tb(NbCol) ' t = t & Nodexs(i).Text & ":" & vbTab & Nodexs(i).NextSibling.Text & vbCrLf
            tb(UBound(tb)) = NodeDoc(i).ChildNodes(0).Text

            Set Nodexs = NodeDoc(i).getelementsbytagname("Name")
            For a = 0 To Nodexs.Length - 1
                Select Case Nodexs(a).Text
                    Case "datedoc": tb(5) = Nodexs(a).NextSibling.Text
                    Case "numadh": tb(1) = Nodexs(a).NextSibling.Text
                    Case "numcli": tb(0) = Nodexs(a).NextSibling.Text
                    Case "cciv": tb(6) = Nodexs(a).NextSibling.Text
                    Case "nom1": tb(8) = Nodexs(a).NextSibling.Text
                    Case "nom2": tb(7) = Nodexs(a).NextSibling.Text
                    Case "cetat": tb(4) = Nodexs(a).NextSibling.Text
                End Select

            Next
            T = T & Join(tb, ";") & IIf(i < NodeDoc.Length - 1, vbCrLf, "")
        Next
    End With
    x = FreeFile: Open compilcsv For Append As #x: Print #x, T: Close #x
    mangetout = True
End Function
maintenant tu peux cocher résolu a droite de ce message😉
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
patricktoulon à dit:
re
c'est pas une ligne qu'il faut changer
on garde le moteur on met un carbu double corps on remplace les cable par l'hydrolique
on modifie un peu ici et là
on la transform en fonction
on ajoute une sub de pilotage (grand guidon)
😀
choisi le dossier dans la boite de dialogue
VB: 
Sub test()
    Dim sfolder$, fichier, header$, y&, file$
    fichier = ThisWorkbook.Path & "\compilation.csv"
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sfolder = .SelectedItems(1)
            Else: Exit Sub
        End If
    End With
    header = "NumeroCient;NumeroContrat;NumeroSinistre;Identifiant Unique document;Code Maquette;Date de creation Document;Civilité;Nom;Prenom;" & _
              "branche;famille;Sous famille;Sous Famille2;Libellé Produit;Univers;sendflux;sourceged;libelléstatut;docencrys;" & _
              "IDAQUISIT;IDAQUISIT;IDAQUISIT;Chemin d'acces au fichier"
    y = FreeFile: Open fichier For Output As #y: Print #y, header: Close #y
    NbCol = UBound(Split(header, ";"))

    file = Dir(sfolder & "\*.xml")
    Do While file <> ""
        ok = mangetout(sfolder & "\" & file, fichier, NbCol)
       ' MsgBox file
        Do While a = 500: DoEvents: a = a + 1: Loop
        DoEvents
        file = Dir()
    Loop
    MsgBox "votre compilation en csv est prête "


End Sub

Function mangetout(myfile, compilcsv, NbCol)
    Dim T, NodeDoc, Nodexs As Object, x&, header, tabhead, tb$(), i

    With CreateObject("microsoft.xmldom")
        .Load myfile
        Set NodeDoc = .getelementsbytagname("Document")
        For i = 0 To NodeDoc.Length - 1
            ReDim tb(NbCol) ' t = t & Nodexs(i).Text & ":" & vbTab & Nodexs(i).NextSibling.Text & vbCrLf
            tb(UBound(tb)) = NodeDoc(i).ChildNodes(0).Text

            Set Nodexs = NodeDoc(i).getelementsbytagname("Name")
            For a = 0 To Nodexs.Length - 1
                Select Case Nodexs(a).Text
                    Case "datedoc": tb(5) = Nodexs(a).NextSibling.Text
                    Case "numadh": tb(1) = Nodexs(a).NextSibling.Text
                    Case "numcli": tb(0) = Nodexs(a).NextSibling.Text
                    Case "cciv": tb(6) = Nodexs(a).NextSibling.Text
                    Case "nom1": tb(8) = Nodexs(a).NextSibling.Text
                    Case "nom2": tb(7) = Nodexs(a).NextSibling.Text
                    Case "cetat": tb(4) = Nodexs(a).NextSibling.Text
                End Select

            Next
            T = T & Join(tb, ";") & IIf(i < NodeDoc.Length - 1, vbCrLf, "")
        Next
    End With
    x = FreeFile: Open compilcsv For Append As #x: Print #x, T: Close #x
    mangetout = True
End Function
maintenant tu peux cocher résolu a droite de ce message😉
Cliquez pour agrandir...
Effectivement ce n'était pas aussi simple... 🙂

Merci pour votre travail et le temps que vous avez pu y consacrer, je vous remercie vivement !
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

F
  • Résolu(e)
Microsoft 365 Comment enregistrer chaque ligne en tant que fichier texte dans Excel?
2
Réponses
24
Affichages
1 K
TooFatBoy
TooFatBoy
P
  • Question Question
Microsoft 365 Automatisation avec création de fichier et d'onglets en fonction des valeurs
2
Réponses
15
Affichages
1 K
pene
P
oguruma
POWERQUERY :: Combinaisons (Table.Combine) de dossiers contenant des fichiers .CSV ou des fichiers Excel - V2
Réponses
0
Affichages
823
oguruma
oguruma
D
  • Question Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
3 K
chris
chris
B
  • Question Question
XL 2010 Alimenter une valeur issue d'une base de donnée dans une textbox crée dynamiquement avec variable
Réponses
6
Affichages
1 K
Bob O' Deville
B
J
  • Question Question
XL 2016 Ajout lignes dans fichier CSV avec filtrage - VBA
Réponses
2
Affichages
2 K
Joshua P
J
T
  • Question Question
XL 2019 Récupéré donner dans un tableau suivant le choix Checkbox
Réponses
2
Affichages
892
Tipeu
T
G
  • Question Question
XL 2019 Copie feuille active dans répertoire avec nom fichier dynamique
Réponses
5
Affichages
1 K
guiyom
G
A
  • Question Question
Importer le nom du fichier XML dans Excel
Réponses
2
Affichages
1 K
adsal
A
I
  • Question Question
Microsoft 365 Récupérer valeurs dans une cellule de plusieurs fichiers Excel situés dans dossier partagé d'entreprise
2
Réponses
23
Affichages
9 K
IlyesT36
I
Undersound
  • Question Question
XL 2016 Création d'un fichier Analyse qui compare fichier Original et fichier Traité
Réponses
3
Affichages
1 K
Undersound
Undersound
M
  • Question Question
XL 2010 comment passer une selection de cellules excel dans une fonction personaliseé VBA ?
2
Réponses
16
Affichages
2 K
Mathieu Régis
M
F
  • Question Question
XL 2016 Svp aidé moi avec les fonctions Somme.SI ou SOMMEPROD & RECHERCHEV
Réponses
0
Affichages
894
Francis Djamba
F
M
  • Question Question
Exporter données excel vers autre fichier qui s'enregistre
Réponses
12
Affichages
3 K
pinpon13
P
B
  • Question Question
Mappage XML dans Excel : relation non préservée
Réponses
0
Affichages
3 K
Bayn
B
P
  • Question Question
VBA SumIf avec nom d'onglet et nom de fichier en variables
Réponses
2
Affichages
3 K
pauline6172
P
S
  • Question Question
Gestion de traductions XML sous Excel
Réponses
7
Affichages
1 K
Guest
G
M
  • Question Question
Fichier CSV
Réponses
3
Affichages
1 K
MajIsh
M
F
  • Question Question
Travailler un fichier XML pour le sortir en CSV
Réponses
5
Affichages
1 K
flyjodel
F
R
  • Question Question
importation fichier excel tableaux multi feuilles dans Word avec un Template
Réponses
3
Affichages
1 K
rogber
R
Retour