Microsoft 365 Créer en VBA un Fichier Xml a partir d'un tableau

[moupa]

Bonjour Le forum et tous mes meilleurs vœux pour 2025

J'aurais besoin d'une aide de votre part, car cette année nous allons organiser le CF UNSS Lycées de course d'orientation et j'ai un soucis de relation des fichiers excel et xml qui sont utilisés entre deux logiciels!!
Mon logiciel de chronométrage peut utiliser les deux formats d'extensions, excel ou xlm, par contre mon logiciel de traçage lui n'utilise qu'une seule extension pour importer ou exporter cad du xml et le concepteur du logiciel m'a dit qu'il ne le ferait pas, pour l'instant une importation avec un fichier excel

J'ai tenté de construire le xml via excel mais malgré toutes les tentatives je n'y arrive pas, mais je cru lire en interrogeant le net que cela était possible de faire cette construction en vba!

Du coup j'ai besoin de votre aide, car moi j'avoue ne pas avoir les compétence pour cela!

Je vous met en PJ le fichier excel ou seront stockés les données d'échanges entre les deux logiciels, ainsi que le fichier xml(mis en txt our vous le mettre à disposition) que j'aurais besoin. Ce fichier est une extraction à partir de se logiciel ou bien sur il n'y a pas toutes les donnés que j'ai mis dans le fichier excel et je logiciel gère les modifications qui pourraient être différentes par apport à se qui a déjà été écrit!

Par avance merci de votre aide
Moupa

 

[sylvanu]

Bonjour Moupa,
Votre XML ne correspond pas à ce que donnerais le XML généré par XL.
Donc sans connaissance de la structure j'ai tenté cette PJ vraiment au pif, en essayant d'extraire la structure de votre fichier txt.
Le XML est sur le bureau ( renommé aussi en xml.txt dans cette PJ )
Par contre si cela ne marche pas, alors je n'ai aucune solution à vous proposer.

Attention, MAJ avec la V2, la V1 n'avait pas la structure de terminaison.

 

[moupa]

Bonsoir Sylvanu

merci d'avoir chercher à m'aider, il y a quand même un soucis, car dès que je lance la macro cela efface les cellules de la colonne A à partir de 7++++ sur la feuil1 ?

 

[sylvanu]

Re,
Oups, le bug de débutant. Juste un petit point.

C'est :
.[A7:A10000].Clear
et non
[A7:A10000].Clear

Sorry.

 

[moupa]

Bonjour Sylvanu, c'est presque cela, mais j'ai des erreurs sur la structure!

C'est vrai que sans structure se n'est pas facile, comme je suis entrain de me prendre la tête depuis une heure pour trouvé le schmilblick, je vais prendre un moment de repos ;-)

D'ici demain midi j’essaie de préparer une structure de fichier avec l'extraction et je re dépose une version4

encore merci pour ton aide
moupa

 

[moupa]

re bonjour,

Voilà je viens de regarder et j'ai cherché les coquilles de la structure, du coup dans la version 4 j'ai mis deux onglets:

1. New_trame qui correspond au tableau qui servira à la structure du xml exporté du logiciel
2. commentaire ou j'ai mis mes remarques suivant mes recherches et

En espérant que cela puisse vous servir à m'aider?
cordialement
pascal

 

[sylvanu]

Bonsoir,
C'est vraiment fastidieux.
Essayez cette PJ.

NB: Je ne suis pas arrivé à supprimer les guillemets. Je regarderais plus tard comment s'en sortir.

 

[moupa]

bonsoir Sylvanu

Merci pour ta réactivité, et ton SUPERBE travail

Nous y somme presque, j'ai modifier ta macro car il y avait une p'tite erreur d'écriture pour les fins de balise ou le / était du mauvais coté
par contre il manque une balise à la fin que j'ai mis en violet et en gras ci-dessous, mais là je ne sais pas ou écrire cela dans ta macro

</TeamMemberCourseAssignment>

</TeamCourseAssignment>

</RaceCourseData>

</CourseData> en rajoutant cette balise et en modifiant l’entête j'ai réussi à importer dans le logiciel

 

[sylvanu]

Re,
J'ai changé la méthode de génération du fichier texte, cela supprime les guillemets.
Mais est ce que cela marche toujours .....

 

[patricktoulon]

bonsoir @moupa @sylvanu
il y a des outils pour çaj'ai ajouter ma fonction perso pour crer un fichier conforme
selon la norme lexicale pretendue dans la ligne de postprocessing
si il faut imbriquer autrement vous le direz
pour que vous puissiez vous débrouiller un peu quand même j'ai utilisé le même nom que les balise pour les variable
et voila vous avez un xml en bon et due forme et indenté comme il se doit

Sub test()
    Dim BibNumber, TeamName, ClassName, BibNumber2, Leg, TeamMemberName, CourseName, CourseFamily

    Dim DocXml, CourseData, RaceCourseData

    Set DocXml = CreateObject("microsoft.xmldom")

    Set CourseData = DocXml.appendChild(DocXml.createElement("CourseData"))
    CourseData.setAttribute "xmlns", "'http://www.orienteering.org/datastandard/3.0' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'"
    CourseData.setAttribute "iofVersion", "3.0"
    CourseData.setAttribute "createTime", Format(Now, "yyyy-mm-dd""T""hh:nn:ss")
    CourseData.setAttribute "creator", "Condes version 10.6.3"

    Set levent = CourseData.appendChild(DocXml.createElement("event"))
    Set lenam = levent.appendChild(DocXml.createElement("name"))
    lenam.Text = "CFCO UNSS 2025 21/05/2025"

    Set RaceCourseData = CourseData.appendChild(DocXml.createElement("RaceCourseData"))
    x = 0
    For lig = 2 To Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
        y = Feuil1.Cells(lig, 1)
        If y <> x Then
            Set cassign = RaceCourseData.appendChild(DocXml.createElement("TeamCourseAssignment"))
            x = y

        Else
            Set BibNumber = cassign.appendChild(DocXml.createElement("BibNumber"))
            BibNumber.Text = Feuil1.Cells(lig, 1).Value

            Set TeamName = cassign.appendChild(DocXml.createElement("TeamName"))
            TeamName.Text = Feuil1.Cells(lig, 2)

            Set ClassName = cassign.appendChild(DocXml.createElement("ClassName"))
            ClassName.Text = Feuil1.Cells(lig, 3)

            Set Leg = cassign.appendChild(DocXml.createElement("Leg"))
            Leg.Text = Feuil1.Cells(lig, 5)

            Set TeamMemberName = cassign.appendChild(DocXml.createElement("TeamMemberName"))
            TeamMemberName.Text = Feuil1.Cells(lig, 6)

            Set CourseName = cassign.appendChild(DocXml.createElement("CourseName"))
            CourseName.Text = Feuil1.Cells(lig, 7)

            Set CourseFamily = cassign.appendChild(DocXml.createElement("CourseFamily"))
            CourseFamily.Text = Feuil1.Cells(lig, 8)


        End If

    Next

    SaveFormatDocToFileXL DocXml, Environ("userprofile") & "\Desktop\moncourxexml.xml"

End Sub

'fonction pour ecrire le fichier au format conforme
'fonction issue du creatorRibbonX
'inpose le format UTF-8 et indente le code
'Auteur patricktoulon
Public Sub SaveFormatDocToFileXL(ByVal doc, ByVal FileName As String)
    Dim ReaderXml As Object, StreamFormaté As Object, WriterFormat As Object, elem

    Set ReaderXml = CreateObject("MSXML2.SAXXMLReader.6.0")
    Set StreamFormaté = CreateObject("ADODB.Stream")
    Set WriterFormat = CreateObject("MSXML2.MXXMLWriter")

    With StreamFormaté
        .Open
        .Type = 1 'adTypeBinary
        With WriterFormat
            .omitXMLDeclaration = False
            '.standalone = True
            .byteOrderMark = False 'If not set (even to False) then
            '.encoding is ignored.
            .Encoding = "utf-8" 'Even if .byteOrderMark = True
            'UTF-8 never gets a BOM.
            .indent = True
            .output = StreamFormaté
            With ReaderXml
                Set .contentHandler = WriterFormat
                Set .dtdHandler = WriterFormat
                Set .errorHandler = WriterFormat
                .putProperty "http://xml.org/sax/properties/lexical-handler", WriterFormat
                '.putProperty "http://xml.org/sax/properties/declaration-handler", WriterFormat
                .Parse doc
            End With
        End With
        If Dir(FileName) <> "" Then Kill FileName
        .SaveToFile FileName
        .Close
    End With
    Set ReaderXml = Nothing
    Set StreamFormaté = Nothing
    Set WriterFormat = Nothing
End Sub

pour vous donner une idée du rendu du fichier ouvert dans le blocknot

je joins le fichier bien évidemment
meilleurs veux
Patrick

 

[patricktoulon]

et pour vous aider encore plus je fait du postappending
ce qui vous permettra de mettre qui vous voulez dans qui vous voulez
la decison se fera ici

 cassign.appendChild (BibNumber)
            cassign.appendChild (TeamName)
            cassign.appendChild (ClassName)
            cassign.appendChild (Leg)
            cassign.appendChild (TeamMemberName)
            cassign.appendChild (CourseName)
            cassign.appendChild (CourseFamily)

la sub complete

Sub test()
    Dim BibNumber, TeamName, ClassName, BibNumber2, Leg, TeamMemberName, CourseName, CourseFamily

    Dim DocXml, CourseData, RaceCourseData

    Set DocXml = CreateObject("microsoft.xmldom")

    Set CourseData = DocXml.appendChild(DocXml.createElement("CourseData"))
    CourseData.setAttribute "xmlns", "'http://www.orienteering.org/datastandard/3.0' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'"
    CourseData.setAttribute "iofVersion", "3.0"
    CourseData.setAttribute "createTime", Format(Now, "yyyy-mm-dd""T""hh:nn:ss")
    CourseData.setAttribute "creator", "Condes version 10.6.3"

    Set levent = CourseData.appendChild(DocXml.createElement("event"))
    Set lenam = levent.appendChild(DocXml.createElement("name"))
    lenam.Text = "CFCO UNSS 2025 21/05/2025"

    Set RaceCourseData = CourseData.appendChild(DocXml.createElement("RaceCourseData"))
    x = 0
    For lig = 2 To Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
        y = Feuil1.Cells(lig, 1)
        If y <> x Then
            Set cassign = RaceCourseData.appendChild(DocXml.createElement("TeamCourseAssignment"))
            x = y

        Else
            Set BibNumber = DocXml.createElement("BibNumber")
            BibNumber.Text = Feuil1.Cells(lig, 1).Value

            Set TeamName = DocXml.createElement("TeamName")
            TeamName.Text = Feuil1.Cells(lig, 2)

            Set ClassName = DocXml.createElement("ClassName")
            ClassName.Text = Feuil1.Cells(lig, 3)

            Set Leg = DocXml.createElement("Leg")
            Leg.Text = Feuil1.Cells(lig, 5)

            Set TeamMemberName = DocXml.createElement("TeamMemberName")
            TeamMemberName.Text = Feuil1.Cells(lig, 6)

            Set CourseName = DocXml.createElement("CourseName")
            CourseName.Text = Feuil1.Cells(lig, 7)

            Set CourseFamily = DocXml.createElement("CourseFamily")
            CourseFamily.Text = Feuil1.Cells(lig, 8)

            cassign.appendChild (BibNumber)
            cassign.appendChild (TeamName)
            cassign.appendChild (ClassName)
            cassign.appendChild (Leg)
            cassign.appendChild (TeamMemberName)
            cassign.appendChild (CourseName)
            cassign.appendChild (CourseFamily)
       End If
    Next
    SaveFormatDocToFileXL DocXml, Environ("userprofile") & "\Desktop\moncourxexml.xml"
End Sub

voila maintenant vous pouvez imbriquer comme vous le souhaitez il suffit de changer cassign qui est le parent pour celui que vous voulez

 

[moupa]

bonjour a vous,

@sylvanu j'ai essayé la version 7 et j'en suis au même point, cad si je colle l'extraction de votre fichier de la version 7 dans un fichier extrait de mon logiciel à partir de la balise

collage extraction de la version7

et la dernière balise

cela fonctionne, je peux importer dans le logiciel!

@patricktoulon , merci de vous penchez sur les besoins (d'ailleurs se n'est pas la première fois ) le fichier que vous avez fourni n'a pas la bonne structure xml, j'avais mis dans mon deuxième post des commentaires sur le besoin de la structure, du coup cela ne fonctionne pas!
Ensuite pour le post qui est arrivé après 22h, je n'ai pas encore eu le temps de me pencher dessus!
je penses que je m'y mettrais en début de semaine prochaine...

encore merci pour votre aide
moupa

ps: en PJ le fichier xml final qui fonctionne dans l'importation du logiciel

 

[sylvanu]

Bonjour,

cela fonctionne, je peux importer dans le logiciel!

Sauf qu'avec la V7 il n'y a pas de guillemets en trop dans le XML, j'ai changé la façon de générer le fichier.
Apparemment c'est XL qui en générant un fichier texte double les guillemets.
@mapomme,
En fait la structure demandé n'est pas du "vrai" XML mais un truc étrange qui lui ressemble.

le concepteur du logiciel m'a dit qu'il ne le ferait pas

On comprend pourquoi.

 

[patricktoulon]

Bonjour
oui moi j'ai du mal a comprendre la structure tout du moins la demande
et un code xml non indenté ça aide pas
d'ailleurs le bibnumber 1 ne figure pas dans ton dernier xml pourquoi?tu commence à 2?

c'est bien du xml avec postprocessing puisqu'il s'affiche sans erreur mais on sait pas vraiment qui est le child de qui d'autant plus que ca ne respecte aucune règle hiérarchique similaire ou applicable a une qu'on pourrait prendre dans la plage
c'est comme si je te donnais un panier avec des fruits et te demanderais de me les classer sans te donner la règle de tri

 

[sylvanu]

Bonjour Patrick,

d'ailleurs le bibnumber 1 ne figure pas dans ton dernier xml pourquoi?tu commence à 2?

Parce que je suis parti du fichier commenté de Moupa du post #8 qui commence à 2.

un code xml non indenté ça aide pas

Exact, mais je n'ai pas pris de risques, ne sachant pas trop ce qu'il fallait faire, je me suis basé sur le fichier du post #1, et l'analyse de Moupa du post #8 feuille "commentaire" partie "la trame serait donc"