Discussion :

[bforzeus]

Bonjour Tout le monde

j'ai un fichier .txt avec cette format (N°, Nom, Prenom, Dat_nai, Ville,Sexe ..)
et je souhaite le transformé en fichier XML comme suite

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
<Titre> je met ce que je veut et cette valeur ne change pas</Titre>
<Titre2> je doit mettre le nom de mon fichier </Titre2>
<Contenu>
   </Personne>
        <N°> ....</N°>
        <Nom>.....</Nom>
        <Prénom>.....</Prénom>
   <Personne>
   <Personne>
        <N°> ....</N°>
        <Nom>.....</Nom>
        <Prénom>.....</Prénom>
   </Personne>
</Contenu>

pourriez vous m'indiquer comment je pourrai réaliser ça ?

Ps: j'ai essayé de suivre la doc sur le site Microsoft avec la procédure Convert a Range to an XML List mai j'ai le message d'erreur type défini par l'utilisateur non défini

merci d'avance pour votre aide

[BlueMonkey]

Bonsoir,

Dans la version Anglaise de la plage d'aide du site de Microsoft, Create an XML data file and XML schema file, il est indiqué qu'il faut
renommer tous les XMLDoc As msxml2.DOMDocument50 en XMLDoc As msxml2.DOMDocument.

Sinon autre solution pour le format personnalisé souhaité en insérant le code ci-dessous dans l'éditeur VBA (<ALT> + <F11>),
puis en exécutant la macro FormateAnnuairePseudoXml()

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub FormateAnnuairePseudoXml()
 
    Dim wsRes As Worksheet
    Set wsRes = Worksheets.Add
 
    Dim fName As String
    Call Application.FileDialog(msoFileDialogOpen).Show
 
    Workbooks.OpenText Filename:= _
        Application.FileDialog(msoFileDialogOpen).SelectedItems.Item(1), _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True
 
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets(1)
 
    Dim i As Long
    Dim r As Range
    wsRes.Cells(1, 1).Value = "<Titre>" & "je met ce que je veut et cette valeur ne change pas" & "</Titre>"
    wsRes.Cells(2, 1).Value = "<Titre2>" & ActiveWorkbook.Name & "</Titre2>"
    wsRes.Cells(3, 1).Value = "<Contenu>"
    i = 4
 
    For Each r In ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
        Call AddPersonne(wsRes, r, i)
    Next r
 
    wsRes.Cells(i, 1).Value = "</Contenu>"
 
    Application.DisplayAlerts = False
    wsRes.Parent.SaveAs Filename:=Replace(ActiveWorkbook.Name, ".txt", ".xml"), FileFormat:=xlText
    ws.Parent.Close
    Application.DisplayAlerts = True
End Sub
 
Sub AddPersonne(ws As Worksheet, InDataRange As Range, DataLine As Long)
    ws.Cells(DataLine, 2).Value = "<Personne>"
    DataLine = DataLine + 1
 
    Call AddPersonneAllData(ws, InDataRange, DataLine)
 
    ws.Cells(DataLine, 2).Value = "</Personne>"
    DataLine = DataLine + 1
End Sub
 
Sub AddPersonneAllData(ws As Worksheet, InDataRange As Range, DataLine As Long)
    Call AddPersonneData(ws, InDataRange, DataLine, "N°", 0)
    Call AddPersonneData(ws, InDataRange, DataLine, "Nom", 1)
    Call AddPersonneData(ws, InDataRange, DataLine, "Prénom", 2)
End Sub
 
Sub AddPersonneData(ws As Worksheet, InDataRange As Range, DataLine As Long, Titre As String, Col As Integer)
    ws.Cells(DataLine, 3).Value = "<" & Titre & ">" & Trim(InDataRange.Offset(0, Col).Value) & "</" & Titre & ">"
    DataLine = DataLine + 1
End Sub