import fichier XML

Sub ExportDesDonneesXML()
 
On Error Resume Next
 
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
 
Dim Chemin As String
Dim Nom As String
Dim Fichier As String
Dim numfile As Integer
Dim i As Integer
 
Chemin = "N:\MOYENS GENERAUX\Imprimerie\FichiersXMLindicateurs\XML\communication\janvier\"
Nom = ActiveWorkbook.Name
Nom = Split(Nom, ".")(0)                                            'On prend le nom du fichier courant sans son extension .xls
Fichier = Chemin & Nom & ".xml"
 
numfile = FreeFile
Open Fichier For Output As #numfile
Print #numfile, "<?xml version='1.0'  encoding='ISO-8859-1' ?>"
Print #numfile, "<releves>"
i = 10
    While Cells(i, 6) <> ""
        Print #numfile, "<factures>"
            Print #numfile, "<numFacture>" & Cells(i, 1) & "</numFacture>"
            Print #numfile, "<date>" & Cells(i, 2) & "</date>"
            Print #numfile, "<C>" & Cells(i, 3) & "</C>"
            Print #numfile, "<service>" & Cells(i, 4) & "</service>"
            Print #numfile, "<numero>" & Cells(i, 5) & "</numero>"
            Print #numfile, "<intitule>" & Cells(i, 7) & "</intitule>"
            Print #numfile, "<machine>" & Cells(i, 8) & "</machine>"
            Print #numfile, "<couleur>" & Cells(i, 9) & "</couleur>"
            Print #numfile, "<rectoVerso>" & Cells(i, 10) & "</rectoVerso>"
            Print #numfile, "<brochure>" & Cells(i, 11) & "</brochure>"
            Print #numfile, "<formatFini>" & Cells(i, 12) & "</formatFini>"
            Print #numfile, "<nbreDePages>" & Cells(i, 13) & "</nbreDePages>"
            Print #numfile, "<attente>" & Cells(i, 14) & "</attente>"
            Print #numfile, "<nbreDExemplaires>" & Cells(i, 15) & "</nbreDExemplaires>"
            Print #numfile, "<O>" & Cells(i, 16) & "</O>"
            Print #numfile, "<papier>" & Cells(i, 17) & "</papier>"
            Print #numfile, "<Q>" & Cells(i, 18) & "</Q>"
            Print #numfile, "<typeDePapier>" & Cells(i, 19) & "</typeDePapier>"
            Print #numfile, "<S>" & Cells(i, 20) & "</S>"
            Print #numfile, "<NbreDeFeuilles>" & Cells(i, 21) & "</NbreDeFeuilles>"
            Print #numfile, "<feuillesOffset>" & Cells(i, 22) & "</feuillesOffset>"
            Print #numfile, "<V>" & Cells(i, 23) & "</V>"
            Print #numfile, "<NbreDeTours>" & Cells(i, 24) & "</NbreDeTours>"
            Print #numfile, "<X>" & Cells(i, 25) & "</X>"
            Print #numfile, "<montage>" & Cells(i, 26) & "</montage>"
            Print #numfile, "<Z>" & Cells(i, 27) & "</Z>"
            Print #numfile, "<NbreDePlaques>" & Cells(i, 28) & "</NbreDePlaques>"
            Print #numfile, "<AB>" & Cells(i, 29) & "</AB>"
            Print #numfile, "<NbreDexPlies>" & Cells(i, 30) & "</NbreDexPlies>"
            Print #numfile, "<Perfos>" & Cells(i, 31) & "</Perfos>"
            Print #numfile, "<NbreDexAssembles>" & Cells(i, 32) & "</NbreDexAssembles>"
            Print #numfile, "<miseSousPlis>" & Cells(i, 33) & "</miseSousPlis>"
            Print #numfile, "<AG>" & Cells(i, 34) & "</AG>"
            Print #numfile, "<couleur2>" & Cells(i, 35) & "</couleur2>"
            Print #numfile, "<prix>" & Cells(i, 36) & "</prix>"
        Print #numfile, "</factures>"
        i = i + 1
    Wend
 
Print #numfile, "</releves>"
Close #numfile
 
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
 
If (Err.Number <> 0) Then GoTo plantage   'gestion des erreurs afin de prévenir l'utilisateur
 
MsgBox "Les données XML ont bien été exportées.", vbOKOnly + vbInformation, "Message"
 
Exit Sub
 
plantage:
MsgBox "Une erreur s'est produite : l'export des données ne s'est pas passé correctement !", vbCritical
 
End Sub

Sub ActuDonneesClasseur()
'
' ActuDonneesClasseur Macro
' Macro enregistrée le 09/04/2013 par plancot daniel
'
 
'
On Error Resume Next
 
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
Dim Repertoire As String
Dim Fichier As String
Dim ws As Worksheet
 
'-------------- Retrait de la protection de tous les onglets ------------------------
For Each ws In ThisWorkbook.Worksheets
    ws.Unprotect Password:=""
Next ws
 
ActiveWorkbook.XmlMaps("commandesFournitures_Mappage").DataBinding.Refresh          'Appel pour mise à jour des données XML
 
Repertoire = "N:\MOYENS GENERAUX\Imprimerie\FichiersXMLindicateurs\xml\communication\janvier\"
Fichier = Dir(Repertoire & "*.xml")                                                 ' recherche des fichiers .xml dans le répertoire FichiersXMLindicateurs
 
While Fichier <> ""                                                                 ' On importe les données de tous les fichiers xml trouvés dans le mappage releves_Travaux_Imprimerie
    ThisWorkbook.XmlMaps("releves_Travaux_Imprimerie").Import URL:=Repertoire & Fichier
    If (Err.Number = 0) Then Kill (Repertoire & Fichier)                            'S'il n'y a pas eu de pb, une fois l'importation réalisée on suprime le fichier XML afin d'éviter les redondances de données
    Fichier = Dir()
Wend
 
 
    ActiveWorkbook.RefreshAll                                                       'Mise à jour de toutes les requêtes et des TxD
 
'------------------------ Remise en place de la protection des onglets ----------------
For Each ws In ThisWorkbook.Worksheets
    ws.Protect Password:="", DrawingObjects:=False, Contents:=True, Scenarios:=True _
        , UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next ws
 
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
 
If (Err.Number <> 0) Then GoTo plantage    'gestion des erreurs afin de prévenir l'utilisateur
 
MsgBox "Toutes les données ont été actualisées.", vbOKOnly + vbInformation, "Message"
 
Exit Sub
 
plantage:
MsgBox "Une erreur s'est produite : la mise à jour des données a échouée.", vbCritical
 
End Sub