XL 2013 Créer un XML à partir d'une liste XMLS

[SurfingJoe]

Bonjour à tous,

Je voudrais à partir d’une liste avec deux colonnes dans Excel, créer un XML. Je joins ici deux fichiers : MaListe.xlsx et CQJCAO.xml (ce que je cherche à obtenir). Est-ce faisable avec une macro ?

Merci et très bonne journée à tous - même à ceux qui comme moi ne savent pas!-

 

[sylvanu]

Bonjour,
Un essai en PJ avec :

Sub Traduire()
    DerLig = ActiveSheet.Range("A65500").End(xlUp).Row
    chemin = CurDir & "\"
    nomfic = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 5)
    Open chemin & nomfic & ".xml" For Output As #1
    For i = 2 To DerLig
    If Cells(i, 1) <> "" Then
        Print #1, "<message>"
        Print #1, vbTab & "<source>" & Cells(i, 1) & "</source>"
        Print #1, vbTab & "<translation>" & Cells(i, 2) & "</translation>"
        Print #1, "</message>"
    End If
    Next i
    Close
End Sub

Le fichier de sortie porte le même nom que le fichier source et se trouve au même endroit.

 

[patricktoulon]

bonjour
juste en passant
a faire du xml faite le conforme
un xml a une racine dans la quelle on y place les balises, cette racine je l'ai appelé "music"
petit bonus :l'aperçu dans IE

Sub test()
    Dim oCreation As Object, Balise, I&, racine, translation, chemin$, rep
    Set xmldoc = CreateObject("Microsoft.XMLDOM")    'creation
    Set racine = xmldoc.createelement("MUSIC")    'ajout de la racine "music"
    xmldoc.appendchild racine    'insertion dans le document (append) de la racine
    Set oCreation = xmldoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""")    'creation de l'entete du process
    xmldoc.InsertBefore oCreation, xmldoc.ChildNodes.Item(0)    'insertion parametre process


    DerLig = ActiveSheet.Range("A65500").End(xlUp).Row
    For I = 2 To DerLig
        If Cells(I, 1) <> "" Then

            Set Balise = xmldoc.createelement("message")
            racine.appendchild (Balise)

            Set Source = xmldoc.createelement("source"): Source.Text = Cells(I, 1)
            Balise.appendchild (Source)

            Set translation = xmldoc.createelement("translation"): translation.Text = Cells(I, 2)
            Balise.appendchild (translation)


        End If
    Next
    chemin = ThisWorkbook.Path & "\toto.xml"    'chemin à adapter
    xmldoc.Save chemin
    rep = MsgBox("voulez voir voir le résultat dans IE", vbYesNo)
    If rep = vbYes Then
        With CreateObject("internetexplorer.application")
            .Visible = True
            .navigate chemin
        End With
    End If
End Sub

 

[SurfingJoe]

MAGNIFIQUE ! Sylvanu, mille mercis c'est exactement ce que je cherchais... Très bonne soirée, SJ

 

[patricktoulon]

MAGNIFIQUE ! Sylvanu, mille mercis c'est exactement ce que je cherchais... Très bonne soirée, SJ

re
bonsoir ben non !! pas manifique le fichier produit par sylvanu n'est pas exploitable en tant que fichier XML y a qu'a l'ouvrir avec IE ou un lecteur XML pour s'en rendre compte
donc selon la destination du fichier mieux vaut faire les choses conforme au DOM

 

[SurfingJoe]

Merci beaucoup Patricktoulon, je vais aussi essayer ta macro mais celle que m'a envoyé Sylvanu est simple et me convient. Bonne soirée SJ

 

[patricktoulon]

ok relis moi et surtout ce que j'ai mis en gras avant de continuer dans ton projet

 

[sylvanu]

Bonsoir Patrick,
Tout dépend ce que SurfingJoe veut en faire.
Au vu de son fichier texte, comme il y a des blancs au début, j'ai supposé qu'il allé copier ces données dans un fichier plus conséquent et que ce n'était qu'un exemple. J'ai donc répondu stricto sensu à la demande.
Ceci dit, j'ai archivé votre code.

 

[patricktoulon]

bonsoir sylvanu

j'ai supposé qu'il allé copier ces données dans un fichier plus conséquent et que ce n'était qu'un exemple. J'ai donc répondu stricto sensu à la demande.

je peux vous montrer alors comment on load un fichier xml et lui ajouter/modifier ce que vous voulez ou vous voulez en utilisant juste le DOM 1
si ca vous intéresse bien sur
perso je trouve beaucoup plus simple que de travailler en string

 

[_Thierry]

Bonjour à tous,

Patrick a raison, j'avais eu à faire des XML bien plus compliqués pour un progiciel d'archivage et GED ("Docubase", pour ce qui connaissent) et l'objet "Microsoft.XMLDOM" accessible dans VBA grace à la bibliothèque "Microsoft XML, v6.0" (sous office 2013) à activer pour pouvoir utiliser le code de Patrick, créé vraiment un "vrai" XML sans avoir besoin de XSD, et un fois pigé les éléments, childs, parents etc sont relativement facile à manipuler.

Le faire en créant un TXT avec Open For OutPut n'est pas du tout pratique et en prime ne résulte pas en un vrai XML, qui peut s'ouvrir et se mettre en forme avec un Brower (IE etc) et pas uniquement avec NotePad... Tout dépend du logiciel qui "avalera" ce XML pour SurfingJoe... si il n'y a pas de "Node" ni de "Root" en début...

Bien à vous et bonne fin de week-end
@+Thierry

 

[patricktoulon]

salut @_Thierry

 

[patricktoulon]

@sylvanu
un exemple simple
je reprends le fichier toto.xml que j'ai créé
je l'ouvre et lui rajoute la flûte
remarquez que je n'utilise pas de gestion d'erreur dans le load xml car ici on est dans un shema xml classique puisque non précisé , il sera difficile de faire des erreurs le document est donc loadé selon la norme xml 1.0 induit par l'instruction de prcess en entete un peu comme comme le <doctype> pour le html

Sub test2()
    Dim racine As Object, chemin$, Balise, translation
    chemin = ThisWorkbook.Path & "\toto.xml"'chemin a adapter 
    Set xmldoc = CreateObject("Microsoft.XMLDOM")    'creation
    xmldoc.async = False
    xmldoc.Load (chemin)    
    Do:: Loop Until xmldoc.readyState = 4
    Set racine = xmldoc.getelementsbytagname("MUSIC")(0)
    Set Balise = xmldoc.createelement("message")
    racine.appendchild (Balise)
    Set Source = xmldoc.createelement("source"): Source.Text = "flute"
    Balise.appendchild (Source)
    Set translation = xmldoc.createelement("translation"): translation.Text = "traversiere"
    Balise.appendchild (translation)
    xmldoc.Save chemin
End Sub

a noter que la librairie possède sa propre fonction save vers un fichier
donc open for output bye!!bye!!

 

[patricktoulon]

je récapitule
je crée le XML avec les données de la plage

Sub test()
    Dim oCreation As Object, Balise, I&, racine, translation, chemin$
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")    'creation
    Set racine = xmlDoc.createelement("MUSIC")    'ajout de la racine "music"
    xmlDoc.appendchild racine    'insertion dans le document (append) de la racine
    Set oCreation = xmlDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""ISO-8859-1""")    'creation de l'entete du process
    xmlDoc.InsertBefore oCreation, xmlDoc.ChildNodes.Item(0)    'insertion parametre process


    DerLig = ActiveSheet.Range("A65500").End(xlUp).Row
    For I = 2 To DerLig
        If Cells(I, 1) <> "" Then

            Set Balise = xmlDoc.createelement("message")
            racine.appendchild (Balise)

            Set Source = xmlDoc.createelement("source"): Source.Text = Cells(I, 1)
            Balise.appendchild (Source)

            Set translation = xmlDoc.createelement("translation"): translation.Text = Cells(I, 2)
            Balise.appendchild (translation)


        End If
    Next
    chemin = ThisWorkbook.Path & "\toto.xml"
    xmlDoc.Save chemin

    indenterXML chemin'!!new!!!

End Sub

j'ajoute une donnée au document en queue dans la racine

Sub test_Ajout_element()
    Dim racine As Object, chemin$, Balise, translation
    chemin = ThisWorkbook.Path & "\toto.xml"
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")    'creation
    xmlDoc.async = False
    xmlDoc.Load (chemin)
    Do:: Loop Until xmlDoc.readyState = 4
    
    Set racine = xmlDoc.getelementsbytagname("MUSIC")(0)
    
    Set Balise = xmlDoc.createelement("message")
    racine.appendchild (Balise)
    
    Set Source = xmlDoc.createelement("source"): Source.Text = "flute"
    Balise.appendchild (Source)
    
    Set translation = xmlDoc.createelement("translation"): translation.Text = "traversiere"
    Balise.appendchild (translation)
    
    xmlDoc.Save chemin
 indenterXML chemin'!!new!!!
End Sub

et pour finir histoire de faire les choses propres
on indente le code

Sub indenterXML(chemin As String)
    Set xmlDoc = CreateObject("MSXML2.DOMDOCUMENT")
    Set XMLreader = CreateObject("MSXML2.SAXXMLReader")
    Set XMLwriter = CreateObject("MSXML2.MXXMLWriter")
    Set oStream = CreateObject("ADODB.STREAM")
    oStream.Charset = "ISO-8859-1"
    oStream.Open
    xmlDoc.Load (chemin)
    With XMLwriter
        .indent = True
        .Encoding = "ISO-8859-1"
        .output = oStream    ' "Connexion" de l'objet Writer à l'objet stream
        With XMLreader
            Set .contentHandler = XMLwriter
            Set .dtdHandler = XMLwriter
            Set .errorHandler = XMLwriter
            .putProperty "http://xml.org/sax/properties/lexical-handler", XMLwriter
            .putProperty "http://xml.org/sax/properties/declaration-handler", XMLwriter
            .Parse xmlDoc
        End With
        .flush
    End With
    oStream.SaveToFile chemin, 2
    Set XMLwriter = Nothing: Set XMLreader = Nothing: Set oStream = Nothing: Set xmlDoc = Nothing
End Sub

résultat avec indentation dans le bloknot

voilà c'est kado'

 

[SurfingJoe]

Oui Patrick a certainement raison, mais comme je n'utilise pas directement le résultat, l'option Sylvanu m'a bien dépanné...
La macro de Patrick me semble au top, mais vraiment complexe pour moi, et installer ça en VBA est hors de mes capacités...

Merci, grâce à vous ce forum est super!