Autres Mapper fichier XML dans Excel avec TLE

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)
:D
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
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
F

FS69

XLDnaute Nouveau
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
patricktoulon

patricktoulon

XLDnaute Barbatruc
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)
:D
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
F

FS69

XLDnaute Nouveau
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)
:D
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

Discussions similaires

P
  • Question
Microsoft 365 Fichier XML dans excel
2
Réponses
17
Affichages
1 K
Staple1600
Staple1600
Twing83
  • Résolu(e)
XL 2010 Boucles imbriquées et fichier XML à géométrie variable
2
Réponses
27
Affichages
2 K
patricktoulon
patricktoulon
A
  • Résolu(e)
Microsoft 365 Enregistrer copie d'un fichier avec pour nom le contenu d'une cellule excel (macro)
2
Réponses
15
Affichages
615
firecarl
F
F
  • Résolu(e)
Microsoft 365 Comment enregistrer chaque ligne en tant que fichier texte dans Excel?
2
Réponses
24
Affichages
661
TooFatBoy
TooFatBoy
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
360
Chaton77
Chaton77
D
  • Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
756
AtTheOne
AtTheOne
P
  • Question
Microsoft 365 Publipostage avec Excel
Réponses
10
Affichages
333
Sequoyah
Sequoyah
V
  • Question
Microsoft 365 Créer un fichier élève avec présences, groupes et fiche personnelle de commentaire par élève....
Réponses
3
Affichages
296
Phil69970
Phil69970
M
  • Question
Power Query Convertir un fichier Contacts Gmail et fichier Excel
Réponses
13
Affichages
795
nat54
nat54
L
  • Question
XL 2016 Liste déroulante d'image
2
Réponses
17
Affichages
2 K
littlebird2
L

Membres actuellement en ligne

3 membres et 43 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 708
Messages
2 112 097
Membres
111 416
dernier inscrit
philipperoy83