Discussion :

[danval25]

Bonjour à tous,

Un petit problème avec ma macro:

Elle me permet d’importer plusieurs xml dans une même feuille bout à bout.

Ce fichier reste ouvert toute la journée et je lance la macro via un bouton de temps en temps afin de rapatrier les fichiers xml qui peuvent ou non changer.

Mon problème est le suivant:

Quand je lance la macro elle recopie les xml dans la feuille mais comme il existe déjà des données elle les met à la suite.
Il faudrait donc effacer la feuille avant de réimporter.
À noter la feuille s’appelle "janvier" important car je vais étendre la macro à 11 autres feuilles.

Infos: la feuille possède un mappage et je ne sais pas comment faire pour effacer les données contenues dans celui-ci.

À l’avance merci pour votre aide.


Daniel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub ActuDonneesClasseur()
'
' ActuDonneesClasseur Macro
' Macro enregistrée le 05/10/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
 
 
Repertoire = ThisWorkbook.Path & "\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_Mappage_Jan").Import URL:=Repertoire & Fichier
    If (Err.Number <> 0) Then Kill (Repertoire & Fichier)                            'S'il y a eu un pb lors de l'importation on suprime le fichier XML afin d'éviter les fichiers XML mauvais
    Fichier = Dir()
Wend
 
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

[danval25]

Bonjour,


j'ai bien avancé:

- import des xml dans toutes les feuilles OK

- j'ai mis en place une ligne pour effacer chaque feuille avant l'import.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ws.ListObjects(1).DataBodyRange.Row.Delete xlShiftUp

j'ai le message d'erreur suivant: "qualificateur incorrect"

et je ne trouve pas pourquoi.

voici le code complet de ma macro.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub ActuDonneesClasseur()
'
' ActuDonneesClasseur Macro
' Macro enregistrée le 06/10/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
Dim lemois As String
 
 
'-------------- Retrait de la protection de tous les onglets ------------------------
 
For Each ws In ThisWorkbook.Worksheets(Array("janvier", "fevrier", "mars", "avril", "mai", "juin", "juillet", "aout", "septembre", "octobre", "novembre", "decembre"))
 
            ws.Unprotect Password:=""
            ws.ListObjects(1).DataBodyRange.Row.Delete xlShiftUp
        lemois = ws.Name
 
Repertoire = ThisWorkbook.Path & "\" & lemois & "\"
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_Mappage_" & lemois).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
 
    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

merci pour votre aide


Daniel

[danval25]

j'ai trouvé il manque un "s" à "row".

voila tout fonctionne.

un grand merci à ceux qui mon fait avancer.

daniel