Export XML en macro

C'est basculement parfait !

Merci infiniment !

Je me permet de réouvrir ce topic. J'ai modifié le chemin d'export de fichier pour que ça arrive sur un disque réseau ...
Sauf que je pense qu'il manque une fonction d'authentification car le fichier n'est pas créé (Pas d'erreur de chemin d'accès)

Bonjour,

Je me permets de faire remonter ce post car j'ai un soucis que je ne parviens pas à identifier.

Au moment de l'export, je me retrouve avec l'erreur suivante : Incompatibilité de type

En cherchant j'ai vu qu'il s'agissait sans doute d'un problème lié au fait qu'une variable attend un type spécifique de donnée (String ou date ou autre) et que ce qui est donné ne correspond pas à cette attente.

Sauf que pour le coup l'attente est toujours une chaine de caractère chez moi et c'est ce que j'ai.

Est-ce que quelqu'un pourrait m'aider avec ça ?

Je vous remets le fichier en PJ

je vous mets aussi le code pour l'export XML :

Sub export_XML()
    Dim fname As String
    'ChDir "/Volumes/DIFFUSION/_GRILLES_EXCEL/Programme_xml/" '<- à adapter'
    ChDir "/Users/stephanemex/Library/Containers/com.microsoft.Excel/Data"
    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" And .Cells(i, 6) <> "BA" And .Cells(i, 6) <> "Capsule #1" And .Cells(i, 6) <> "Capsule #2" And .Cells(i, 6) <> "Capsule #3" And .Cells(i, 6) <> "Capsule #4" And .Cells(i, 6) <> "Capsule #5" And .Cells(i, 6) <> "Capsule #6" Then     'exclure PUB comblage / BA et Programme courtet Capsules

                            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 Function

En vous remerciant par avance pour votre aide.

bonjour,

il y a une cellule en erreur dans ton classeur pour jeudi en C156

Ah oui en effet ...

Merci beaucoup