excel et xml

sub convert_to_xml()
reponse = MsgBox("voulez vous generer un fichier xml ?", vbYesNo)
If reponse = vbYes Then
FullPath = InputBox("entrez un chemin complet")
ExportToXML (FullPath), "loto"
MsgBox ("fichier XML généré à l'emplacement suivant:" & vbCrLf _
& vbCrLf & FullPath)
End If

If reponse = vbNo Then End

end sub

'----------------------------------------------------------------------------------------------
'Fonction pour convertir le fichier excel en fichier xml
'----------------------------------------------------------------------------------------------
'PARAMETRES: FullPath: chemin complet de destination du fichier a exporter
' RowName: nom de balise XML donnée à chaque ligne
'RETURN: renvoie vrai si execution OK , faux sinon
'
'EXEMPLE: ExportToXML "C:\Documents and Settings\franck\Bureau\test\loto\mysheet.xml", "loto"
'
' 1) Concue pour etre utilisée comme une macro
' 2) la fonction fonctionne par defaut sur la premiere
' feuille du classeur
' si vous voulez une variable pour designer la feuille,
' vous pouvez ajouter un nombre en parametre
' exemple : worksheets(2) si c'est la deuxieme feuille
' 3) le nom de la feuille sera le premier niveau de
' l'arborescence XML
' 4) la premiere ligne doit contenir les entetes de colonne
' les lignes suivantes doivent contenir les valeurs
' 5) IMPORTANT:
' pas d'espaces blancs dans les entetes de colonne
' pas d'accents dans la feuille

'------------------------------------------------------------------------------------------------

Public Function ExportToXML(FullPath As String, RowName _
As String) As Boolean
On Error GoTo ErrorHandler
Dim colIndex As Integer
Dim rwIndex As Integer
Dim asCols() As String
Dim oWorkSheet As Worksheet
Dim sName As String
Dim lCols As Long, lRows As Long
Dim iFileNum As Integer

Set oWorkSheet = ThisWorkbook.Worksheets(1)
sName = oWorkSheet.Name
lCols = oWorkSheet.Columns.Count
lRows = oWorkSheet.Rows.Count
ReDim asCols(lCols) As String
iFileNum = FreeFile
Open FullPath For Output As #iFileNum
For i = 0 To lCols - 1
If Trim(Cells(1, i + 1).Value) = "" Then Exit For
asCols(i) = Cells(1, i + 1).Value
Next i
If i = 0 Then GoTo ErrorHandler
lCols = i
Print #iFileNum, "<?xml version=""1.0""?>"
Print #iFileNum, "<" & sName & ">"
For i = 2 To lRows
If Trim(Cells(i, 1).Value) = "" Then Exit For
Print #iFileNum, "<" & RowName & ">"
For j = 1 To lCols
If Trim(Cells(i, j).Value) <> "" Then
Print #iFileNum, " <" & asCols(j - 1) & "><![CDATA[";
Print #iFileNum, Trim(Cells(i, j).Value);
Print #iFileNum, "]]></" & asCols(j - 1) & ">"
DoEvents 'OPTIONAL
End If
Next j
Print #iFileNum, " </" & RowName & ">"
Next i
Print #iFileNum, "</" & sName & ">"
ExportToXML = True
ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
Exit Function