Enregistrer automatiquement en XML mappé

Strululu44

XLDnaute Nouveau
Bonjour!

Je voudrais savoir s'il est possible d'enregistrer grace à une macro un fichier excel basique (titres en colonnes, et données en lignes) en fichier XML mappé?

En fait je suis en train de créer une feuille dans un classeur élaboré qui permet d'élargir la base de donnée utilisée par ce classeur en créant une nouvelle feuille.
Vu que les données de la base sont en xml, il faut que la feuille soit enregistrée dans ce format à la fin de sa modification, et je n'arrive pas à trouver comment faire..

Quand j'enregistre une macro, le procédé de mappage XML avec XML Tools n'est pas pris en compte, et je n'obtiens alors qu'un pauvre :

ChDir "C:\Sapin\Loup"
ActiveWorkbook.SaveAsXMLData Filename:= _
"C:\Sapin\Loup\LoupDataBase.xml", Map:=ActiveWorkbook. _
XmlMaps("Root_Mappage")

Etant donné que ce code n'amene aucune procédure de mappage, forcément cela ne marche pas...



Merci pour votre aide
 

Strululu44

XLDnaute Nouveau
Re : Enregistrer automatiquement en XML mappé

Le premier lien défini une fonction qui marche parfaitement

Code:
ExportToXML "C:\mysheet.xml", "Employee"

Voici la fonction

Code:
Public Function ExportToXML(FullPath As String, RowName _
  As String) As Boolean

'PURPOSE: EXPORTS AN EXCEL SPREADSHEET TO XML
'PARAMETERS: FullPath: Full Path of File to Export Sheet to
'             RowName: XML Attribute Name to give to each row

'RETURNS: True if Successful, false otherwise

'EXAMPLE: ExportToXML "C:\mysheet.xml", "Employee"

'NOTES:
'This function has the following quirks and limitations.
'If you find that they are not consistent with the behavior
'you desire for your solution, you should be able to
'modify the code without too much difficulty

'       1) Designed to be used inside Excel as a macro
'        not with VB.  If you want to use from VB
'        Add code to use Excel Object model
'
'       2) This snippet works with the
'          the first worksheet in the workbook.
'          If you want to make this a variable,
'          You can change the code to add the worksheet
'          Number as a parameter.
'
'       3) This code uses the worksheet name as the top-level
'          XML attribute.
'
'       4) The first row of the sheet is assumed to contain the
'          attribute (column) names, while the following rows
'          are assumed to contained the data values
'
'       5) No data for blank cells are written to the
'          XML file.
'
'       6) The CDATA attribute is included with each value
'
'       7) The function assumes that the first column of
'          each row in the sheet has a value.  If it finds a
'          blank first column it exits.  This is in order
'          to prevent it from printing blank row
'******************************************************

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
    'Assumes no blank column names
    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
End Function


Sauf que j'ai un autre problème : Je veux que l'enregistrement de cette nouvelle feuille se fasse dans certains dossier et avec un certain nom. J'ai vu comment faire ceci avec une commande

Code:
ActiveWorkbook.SaveAs Filename:= _
                CheminFichierWeb & NomFichierWeb & DateJourRU & XLS

Mais je n'arrive pas à l'adapter à la fonction... Pourtant je pense que j'y suis presque !

Code:
Sub Exporter()
Dim Folder As String
Folder = "C:\Sapin\"
Dim extension As String
extension = ".xml"
Dim Loup As String
Dim DB As String
Loup = Workbooks("Command.xlsm").Worksheets("Raptor").Range("G4").Value
DB = "DataBase"

[COLOR="Red"]ExportToXML Folder & Loup & DB & extension[/COLOR]

End Sub




J'espère que je ne pose pas de questions trop bêtes...
 
Dernière édition:

Strululu44

XLDnaute Nouveau
Re : Enregistrer automatiquement en XML mappé

Ah ouais j'avais oublié un antislash!!!! :(:(:(
Je suis finalement passé par une méthode détournée où j'utilise une feuille intermédiaire déjà en XML : beaucoup plus simple :)

Merci pour tes indications en tout cas Catrice
 

Statistiques des forums

Discussions
312 686
Messages
2 090 949
Membres
104 705
dernier inscrit
Mike72