Bonsoir,

j'ai un soucis avec du code qui génère une playlist en xml.

Le code compare les Catégories et quand la nouvelle catégorie <> de la nouvelle alors il faut sortir de la boucle et enregistrer le fichier mais là, j'ai du oublié quelque chose, car la boucle continue..;continue...

J'ai une feuille Herbs dans laquelle il y a Ncategorie (1,2...34), Categorie, Herb, Phonetic, Latin, French


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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
 
 
Sub CreatePlaylist() ' création des playlists de pharmacopée pour le lecteur dewplayer en swf
 
Dim res, code As String
Dim FileName, Ncategorie, Categorie, Herb, Phonetic, Latin, French, old_Categorie, Old_Herb
 
'mettre entre guillement le code HTML du fichier a generer
 
code = "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbCrLf
code = code & "<playlist version='1' xmlns='http://xspf.org/ns/0/'>" & vbCrLf
    code = code & "<title></title>" & vbCrLf
    code = code & "<creator></creator>" & vbCrLf
    code = code & "<link></link>" & vbCrLf
    code = code & "<info>t</info>" & vbCrLf
    code = code & "<image></image>" & vbCrLf
 
    code = code & "<trackList>" & vbCrLf
 
 
 
 
Dim ligpoint As Integer
 
    ligpoint = 2
    old_Categorie = ""
    Old_Herb = ""
 
 While Worksheets(TB_Herbs).Cells(ligpoint, PA_HERB).Value <> ""
         Categorie = Worksheets(TB_Herbs).Cells(ligpoint, PA_CATEGORIE).Value
 
    If old_Categorie = Categorie Then
 
 
        While Worksheets(TB_Herbs).Cells(ligpoint, PA_HERB).Value <> ""
                Ncategorie = Worksheets(TB_Herbs).Cells(ligpoint, PA_Ncategorie).Value
                Categorie = Worksheets(TB_Herbs).Cells(ligpoint, PA_CATEGORIE).Value
                Herb = Worksheets(TB_Herbs).Cells(ligpoint, PA_HERB).Value
                Phonetic = Worksheets(TB_Herbs).Cells(ligpoint, PA_PHONETIC).Value
                Latin = Worksheets(TB_Herbs).Cells(ligpoint, PA_LATIN).Value
                French = Worksheets(TB_Herbs).Cells(ligpoint, PA_FRENCH).Value
 
             If old_Categorie = Categorie And Old_Herb <> Herb Then
 
                code = code & "<track>" & vbCrLf
                        code = code & "<location>../MP3/" & Phonetic & ".mp3</location>" & vbCrLf
                        code = code & "<creator>Pascal DUMAS</creator>" & vbCrLf
                        code = code & "<album>Phonétiques des " & Categorie & "</album>" & vbCrLf
                        code = code & "<title>" & Herb & "</title>" & vbCrLf
                        code = code & "<image>../images/" & Phonetic & ".jpg</image>" & vbCrLf
                        code = code & "<latin>" & Latin & "</latin>" & vbCrLf
                        code = code & "<français>" & French & "</image>" & vbCrLf
                        code = code & "<copyright>Copyright Les Corps Énergies</copyright>" & vbCrLf
                        code = code & "<link></link>" & vbCrLf
                code = code & "</track>" & vbCrLf
 
            End If
 
 
                    old_Categorie = Categorie
                    Old_Herb = Herb
                    ligpoint = ligpoint + 1
        Wend
    End If
 
 
        old_Categorie = Categorie
        ligpoint = ligpoint + 1
 
 
    code = code & "</trackList>" & vbCrLf
code = code & "</playlist>" & vbCrLf
 
    code = code & "<!-- concerne les " & Categorie & "  -->" & vbCrLf
    code = code & " <!-- " & ligpoint + 1 & " plantes -->" & vbCrLf
 
'creation du fichier
Set fs = CreateObject("scripting.fileSystemObject")
Set a = fs.CreateTextFile(ActiveWorkbook.Path & "\playlists\playlist" & Ncategorie & ".xml", True, False)
a.WriteLine code
a.Close
ligpoint = ligpoint + 1
Wend
MsgBox " playlist(s) générée(s)"
End Sub
Merci de votre aide !