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 |
Partager