Format date dans export XML
N
Bonjour,
Je ne sais pas comment forcer le format de la date (YYY-MM-DD) dans l'export .xml de ma feuille de calcule.
Voilà comment se fait l'export :
Sub export_XML()
Dim fname As String
ChDir "/Volumes/DIFFUSION/_GRILLES_EXCEL/Programme_xml/" '<- à adapter'
fname = "programme - " & Format(Date, "yyyy-mm-dd") & ".xml" '<- à adapter'
Dim fsT As Object
XMLstring = "<XML version=""1.0"" encoding=""UTF-8"">" & vbNewLine & "<Grille-des-programmes>"
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche"
With ws
DL = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To DL
If .Cells(i, 6) <> "PUB" And .Cells(i, 6) <> "Comblage / BA" And .Cells(i, 6) <> "Programme court" Then 'exclure PUB comblage / BA et Programme court
XMLstring = XMLstring & vbNewLine & vbTab & "<Day day=""" & ws.Name & """>"
For col = 1 To 9
If .Cells(i, col) <> "" Then XMLstring = XMLstring & vbNewLine & vbTab & vbTab & "<" & .Cells(2, col) & ">" & .Cells(i, col).Text & "</" & .Cells(2, col) & ">"
Next col
XMLstring = XMLstring & vbNewLine & vbTab & "</Day>"
End If
Next i
End With
End Select
Next ws
XMLstring = XMLstring & vbNewLine & "</Grille-des-programmes>" & vbNewLine & "</XML>"
Open fname For Output As 1
Print #1, Encode_UTF8(XMLstring)
Close 1
MsgBox "Le fichier ** " & fname & " ** a bien été créé"
End Sub
Public Function Encode_UTF8(astr)
Dim c
Dim n
Dim utftext
utftext = ""
n = 1
Do While n <= Len(astr)
c = AscW(Mid(astr, n, 1))
If c < 128 Then
utftext = utftext + Chr(c)
ElseIf ((c >= 128) And (c < 2048)) Then
utftext = utftext + Chr(((c \ 64) Or 192))
utftext = utftext + Chr(((c And 63) Or 128))
ElseIf ((c >= 2048) And (c < 65536)) Then
utftext = utftext + Chr(((c \ 4096) Or 224))
utftext = utftext + Chr((((c \ 64) And 63) Or 128))
utftext = utftext + Chr(((c And 63) Or 128))
Else ' c >= 65536
utftext = utftext + Chr(((c \ 262144) Or 240))
utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
utftext = utftext + Chr((((c \ 64) And 63) Or 128))
utftext = utftext + Chr(((c And 63) Or 128))
End If
n = n + 1
Loop
Encode_UTF8 = utftext
End FunctionVoici comment sort mon .xml
Et voici la feuille de calcul
Je pourrais faire une version plus légère du fichier si besoin mais en version intégrale il est trop lourd pour être partagé ...
En vous remerciant par avance,