Une macro se lance sur un PC mais sur un autre non.

**Babybel54** · 03/08/2011, 11h38

Bonjour,

Je rencontre actuellement un problême où je ne trouve pas de solutions...

J'ai un programme qui génère 1 fichier excel, un fichier excel rempli à la main, et un fichier comportant un tableau et une macro.

Quand je lance cette dernière, il est lancé être créé un nouveau fichier excel où des données auront été croisé pour remplir le tableau selon une date que je donne.

J'ai 2 ordinateurs dans mon service. On a hébergé nos fichiers excels et macros sur un serveur.
Donc nous utilisons tous les 2 les mêmes fichiers et macros et pas en même temps.

Les 2 pcs ont été installé récemment ils ne difère que par une application.
On utilise Excel 2003.

Sur un des postes cela fonctionne très bien.
Sur l'autre excel ne répond plus et il faut tout fermer par le gestionnaire des tâches.

Merci de m'aider ceci est très important pour mon service.

J'ai déjà essayé de désinstaller / réinstaller Excel 2003, même tout le pack Office.

Mais rien n'y fait.

VB6FR.DLL est bien présent sur le PC.

**bastou93** · 03/08/2011, 12h20

Bonjour,

As tu essayé de faire du pas à pas pour voir à partir de quel instruction cela plante?

Merci

Bastien

**jfontaine** · 03/08/2011, 12h43

Bonjour,

Tu peux aussi avoir un problème de calculs intempestifs.

désactive le calcul automatique en début de code

Code :

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

Application.Calculation = xlCalculationManual

Si pas demieux, il faudrait voir ton code

**Babybel54** · 03/08/2011, 15h17

Bah j'ai fais du pas à pas, mais cela plante aussi.

Mais il n'y avait pas de soucis de code je pense, car il se lance sur tous les autres PCs, sauf celui là.

Mais à part Office 2003, et FileformatsConvert rien n'est installé d'autre en plus...

**bastou93** · 03/08/2011, 16h04

Bah j'ai fais du pas à pas, mais cela plante aussi.

oui mais à quel ligne

car si le début se passe bien c'est peut etre une seul ligne qui pose probleme et lance un conflit.

**Babybel54** · 03/08/2011, 16h07

Et bien en fait dès que la macro a besoin d'une date, je lui donne.
Ensuite elle créé un fichier excel comme cela doit être fait, tout en ouvrant tous les fichiers excel où les données vont être cherchées.

Sauf que à ce moment là tout plante, Excel réfléchit réfléchit réflé zzzzzzZZZZZZzzzzzzz (RIP)

Et le fichier excel créé une fois que tout a bien planté, est vierge ...

**jfontaine** · 03/08/2011, 16h09

sans ton code impossible de t'aider;
Indique nous aussi la ligne ou ca mouline

Invité · 04/08/2011, 05h53

Bonjour

Envoyé par Babybel54

Et bien en fait dès que la macro a besoin d'une date, je lui donne.

Plusieurs choses à contrôler (on ne sait jamais)

Les paramètres de date dans les options régionales sont-elles les mêmes sur tous les PC ?

Philippe

**bastou93** · 04/08/2011, 08h13

Je serais d'avis d'avoir le code et la ligne en question

**francky74** · 04/08/2011, 08h23

Bonjour,

Quand ton pc plante, est-ce qu'il te dit que Excel ne réponds pas ?
Tes fichiers sont-ils très lourds ? y a-t-il beaucoup de données à traiter ? si oui, les traites tu avec un tableau dynamique ?
J'ai déjà rencontré un pb de ce genre où il fallait finallement patienter ... patienter .... ZZZzzzzz parce que quand WINDOZ te dit que le programme ne réponds pas, cela ne veux pas forcément dire que le PC à planté ! C'est souvent parce qu'il calcule à fond !

**Babybel54** · 04/08/2011, 12h01

Bah le truc c'est que les 2 PCs qui executent ce fichier sont identiques, du coup y'en a un ou ca prend un bon 30 sec et l'autre "Ne répond pas"...

Les options réginales sont les mêmes.

Je vais tester de mettre Excel 2007 sur le pote où cela ne fonctionne pas pour tester je viens de le récupérer, et je vous donne la source dans le courant de l'après midi.

Merci déjà de vos nombreuses réponses !

**bastou93** · 04/08/2011, 13h40

ton code est TOP secret pour que tu ne veilles à ce point le mettre

**Babybel54** · 04/08/2011, 14h24

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
Sub Tournées()
'
' A partir du fichier extrait de "Distriplanner" remplir les feuilles de tournée
'
 
Dim Réponse As Date
 
    Application.ScreenUpdating = False
 
'*** Récupération de la date de traitement
    Réponse = InputBox("Date de livraison (JJ/MM/AAAA)?", "Renseignement de la date")
    Nom_fichier = Day(Réponse) & "-" & Month(Réponse) & "-" & Year(Réponse)
 
'*** Ouverture du fichier avec l'extraction de base de donnéees
    Workbooks.Open Filename:= _
        "\\frhosclunefs1\sitcar\Distriplanner PF\Test recup base.xls", UpdateLinks:=0
 
'*** Ouverture de la base clients
    Workbooks.Open Filename:= _
        "\\frhosclunefs1\sitcar\Clients.xls", UpdateLinks:=0
 
'*** Ouverture d'un nouveau fichier qui servira à enregistrer les feuilles de tournée
'*** et enregistrement sous le nom "Tournées du " + la Réponse
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:= _
        "\\frhosclunefs1\sitcar\Distriplanner PF\Tournées du " & Nom_fichier & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
'    ActiveWorkbook.SaveAs Filename:= _
        "C:\Mes documents\Christelle\Nouveau dossier\Tournées du " & Nom_fichier & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
 
'*** Copie des feuilles Modèle, Clients et Tournées le nouveau fichier
    Windows("Macro feuille de tournée.xls").Activate
    Sheets("Modèle").Select
    Sheets("Modèle").Copy After:=Workbooks("Tournées du " & Nom_fichier & ".xls").Sheets(3)
    Windows("Macro feuille de tournée.xls").Activate
    Sheets("Clients").Select
    Sheets("Clients").Copy Before:=Workbooks("Tournées du " & Nom_fichier & ".xls").Sheets(3)
    Range("A5").Select
    Range("D2").Value = "'" & Réponse
    Windows("Macro feuille de tournée.xls").Activate
    Sheets("Tournées").Select
    Sheets("Tournées").Copy Before:=Workbooks("Tournées du " & Nom_fichier & ".xls").Sheets(3)
    Range("A5").Select
    Range("C2").Value = "'" & Réponse
 
'*** Activation du fichier d'extraction de la base de données et début du corps de la
'*** macro
    Windows("Test recup base.xls").Activate
    Sheets("TOURS").Activate
    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("A1").Select
    Sheets("RANGS").Activate
    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("A1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=Réponse
    Selection.End(xlDown).Select
    If ActiveCell.Row = 65536 Then
        MsgBox ("Pas de magasin à livrer à cette date!")
        Exit Sub
    End If
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    While ActiveCell <> Réponse
        ActiveCell.Offset(1, 0).Activate
    Wend
    While ActiveCell.Value <> "" And ActiveCell.Value = Réponse
        Magasin = Mid(ActiveCell.Offset(0, 4), 2, 5) + 0
        Tournée = ActiveCell.Offset(0, 2).Value
        Qté_EUT = ActiveCell.Offset(0, 7).Value
        If ActiveCell.Offset(0, 8).Value = "" Then
            Tonnage = 0
            Else: Tonnage = ActiveCell.Offset(0, 8).Value * 1000
        End If
        Rang = ActiveCell.Offset(0, 3).Value
        Windows("Tournées du " & Nom_fichier & ".xls").Activate
        Sheets("Tournées").Select
        Range("A5").Select
        Selection.AutoFilter Field:=1, Criteria1:=Tournée
        Selection.End(xlDown).Select
        Ligne = ActiveCell.Row
        Selection.AutoFilter
        If Ligne = 65536 Then
            Selection.End(xlUp).Select
            Windows("Test recup base.xls").Activate
            Sheets("TOURS").Select
            Range("A1").Select
            Selection.AutoFilter
            Selection.AutoFilter Field:=1, Criteria1:=Réponse
            Selection.AutoFilter Field:=3, Criteria1:=Tournée
            Selection.End(xlDown).Select
            Quai = ActiveCell.Offset(0, 3).Value
            Mise_à_quai = ActiveCell.Offset(0, 4).Value
            Date_départ = ActiveCell.Offset(0, 5).Value
            Date_retour = ActiveCell.Offset(0, 6).Value
            Tracteur = ActiveCell.Offset(0, 7).Value
            Chauffeur = ActiveCell.Offset(0, 8).Value
            Remorque = ActiveCell.Offset(0, 9).Value
            Transporteur = ActiveCell.Offset(0, 10).Value
            Windows("Tournées du " & Nom_fichier & ".xls").Activate
            Sheets.Add
            ActiveSheet.Name = Tournée
            Sheets("Modèle").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Feuille = "" & Tournée
            Sheets(Feuille).Select
            ActiveSheet.Paste
            ActiveWindow.Zoom = 50
            Application.CutCopyMode = False
            Range("A1:Z25").Select
            Range("Z25").Activate
            Application.CutCopyMode = False
            ActiveSheet.PageSetup.PrintArea = "$A$1:$AC$25"
            With ActiveSheet.PageSetup
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0)
                .BottomMargin = Application.InchesToPoints(0)
                .HeaderMargin = Application.InchesToPoints(0)
                .FooterMargin = Application.InchesToPoints(0)
                .PrintHeadings = False
                .PrintGridlines = False
                .CenterHorizontally = True
                .CenterVertically = True
                .Orientation = xlLandscape
                .Draft = False
                .BlackAndWhite = False
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Range("B11").Select
            Range("G2").Value = "TOURNEE " & Tournée
            Range("W2").Value = "QUAI: " & Quai
            Range("C4").Value = Transporteur
            Range("C5").Value = Chauffeur
            Range("C6").Value = Tracteur
            Range("C7").Value = Remorque
            Range("G5").Value = "'" & Réponse
            If Mise_à_quai = "" Then
                Range("Y6").Value = "'" & Mise_à_quai
            Else
                If Day(Mise_à_quai) < 10 Then
                    Jour = "0" & Day(Mise_à_quai)
                Else
                    Jour = Day(Mise_à_quai)
                End If
                If Month(Mise_à_quai) < 10 Then
                    Mois = "0" & Month(Mise_à_quai)
                Else
                    Mois = Month(Mise_à_quai)
                End If
                Range("W6").Value = "'" & Jour & "/" & Mois & "/" & Year(Mise_à_quai)
            End If
            Range("B11").Select
            Sheets("Tournées").Select
            Range("A5").Select
            Selection.End(xlDown).Select
            Position = ActiveCell.Row
            If Position = 65536 Then
                Range("A6").Select
            Else
                If Position = 6 Then
                    Selection.End(xlDown).Select
                    Position = ActiveCell.Row
                    If Position = 65536 Then
                        Range("A7").Select
                    Else
                        ActiveCell.Offset(1, 0).Activate
                    End If
                Else
                    ActiveCell.Offset(1, 0).Activate
                End If
            End If
            ActiveCell.Value = Tournée
            ActiveCell.Offset(0, 1).Value = Quai
            ActiveCell.Offset(0, 2).Value = Chauffeur
            ActiveCell.Offset(0, 3).Value = Transporteur
            ActiveCell.Offset(0, 4).Value = Tracteur
            ActiveCell.Offset(0, 5).Value = Remorque
            ActiveCell.Offset(0, 6).Value = "'" & Mise_à_quai
            ActiveCell.Offset(0, 8).Value = "'" & Date_départ
            ActiveCell.Offset(0, 10).Value = "'" & Date_retour
        End If
        Windows("Tournées du " & Nom_fichier & ".xls").Activate
        Feuille = "" & Tournée
        Sheets(Feuille).Select
        ActiveCell.Value = Magasin
        ActiveCell.Offset(0, 4).Value = Qté_EUT
        ActiveCell.Offset(0, 5).Value = Tonnage
        ActiveCell.Offset(0, 22).Value = Rang
        ActiveCell.Offset(1, 0).Activate
        Sheets("Clients").Select
        ActiveCell.Offset(1, 0).Activate
        ActiveCell.Value = "'" & Mise_à_quai
        ActiveCell.Offset(0, 1).Value = "'" & Date_départ
        ActiveCell.Offset(0, 2).Value = Tournée
        ActiveCell.Offset(0, 3).Value = Transporteur
        ActiveCell.Offset(0, 4).Value = Magasin
        ActiveCell.Offset(0, 7).Value = Quai
        Windows("Test recup base.xls").Activate
        Sheets("RANGS").Activate
        ActiveCell.Offset(1, 0).Activate
    Wend
    ActiveWindow.Close savechanges:=False
    Sheets("Tournées").Select
    Range("A6").Select
    While ActiveCell.Value <> ""
        Feuille = "" & ActiveCell.Value
        Sheets(Feuille).Select
        Range("B11:X23").Select
        Selection.Sort Key1:=Range("X11"), Order1:=xlDescending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        Columns("X:X").Delete
        Range("B11").Select
        Sheets("Tournées").Select
        ActiveCell.Offset(1, 0).Activate
    Wend
    Range("A6").Select
    Sheets("Clients").Select
    Range("A6").Select
    Selection.End(xlDown).Select
    Ligne_fin = ActiveCell.Row
    Range("A6:J" & Ligne_fin).Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1"), _
        Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A6").Select
    ActiveWorkbook.Save
    Windows("Macro feuille de tournée.xls").Activate
    Application.ScreenUpdating = False
    ActiveWindow.Close savechanges:=False
End Sub

Non non pas top secret, mais il était sur un serveur et comme j'étais en deplacement je n'y avais pas accès, car ce maudit accès VPN ne marche pas très bien car mon entreprise est en pleine campagne en 512K...

Question subsidiaire : Pourquoi on ne voit pas mon avatar à moi :'( ?

**bastou93** · 04/08/2011, 14h29

Merci pour le code, la ligne qui pose problème c'est laquelle?

Pour ton avatar je ne sais pas mais il y a 2 photos un de profil et l'autre c'est avatar...

**Babybel54** · 04/08/2011, 15h48

Bastien aucune idée, puisque sur un poste ca fonctionne et sur l'autre ca plante... Du coup je ne vois pas où cela plante.

**bastou93** · 04/08/2011, 15h52

A ok, met toi sur le pc qui plante et essaye de mettre un point d’arrêt sur la première ligne de ta la macro:

Code :

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

Sub Tournées()

pour cela tu clique sur la zone grise comme ci dessous (ou alors tu sélectionne la ligne et F9):

Ensuite tu lance ta macro et tu passe ligne pas ligne touche "F8" jusqu'à avoir le bug tu verra ainsi la ligne en question

Tiens nous au jus

**MattChess** · 04/08/2011, 23h18

Bonjour Babybel54,

1. Cause possible : réseau ou imprimante ?

Envoyé par Babybel54

Sur l'autre excel ne répond plus et il faut tout fermer par le gestionnaire des tâches.

Sur ce second PC, est-ce que l'accès réseau fonctionne correctement pour accéder aux .xls distants sur le serveur ?

Ce second PC a-t-il une imprimante comme cela pourrait être le cas sur le premier PC ou l'imprimante est en réseau ?
Dans la méga macro Tournées(), on trouve ligne 120 à 138 la configuration pour l'impression.
Cela peut être la source du problème sur ce second PC.

2. Revue de code

Il est extrêmement difficile de comprendre, maintenir, faire évoluer, mettre au point une seule macro de 240 lignes car la complexité augmente exponentiellement avec le nombre de lignes dans une seule procédure, pas avec le nombre de procédures.
Nul doute qu'à force de patience, on peut arriver à faire fonctionner cette énorme macro. Et puis on change de PC ou on modifie la position d'une colonne ou d'une rangée ou l'ordre des feuilles dans un classeur et cela va demander un effort gigantesque pour la faire fonctionner à nouveau.

Cette macro n'a aucune gestion d'erreurs sur la date saisie et sur l'ouverture des classeurs.

Envoyé par Babybel54

Et le fichier excel créé une fois que tout a bien planté, est vierge ...

Ligne 24, on ajoute un nouveau classeur que l'on sauve sous le nom "Tournées du ...".
Cela veut dire que juste après la création, son unique feuille est encore vide.

Code :

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

Sheets("Modèle").Copy After:=Workbooks("Tournées du " & Nom_fichier & ".xls").Sheets(3)

Comment peut-on copier une feuille "Modèle" après la troisième feuille du classeur nouvellement créé puisqu'il n'a qu'une seule feuille vide ?

On s'interroge sur le fonctionnement de la ligne 73 :

Code :

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

Magasin = Mid(ActiveCell.Offset(0, 4), 2, 5) + 0

Car on ne peut pas additionner une chaîne avec la constante numérique zéro.

Ligne 112 :

Code :

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

 Feuille = "" & Tournée

Visiblement il y a eu une intention d'ajouter un préfixe mais on n'est pas allé jusqu'au bout.

Ligne 202 :

Code :

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

ActiveCell.Value = "'" & Mise_à_quai

Dans le cas où la tournée existe déjà, on ne passe pas dans le méga If de création d'une tournée qui initialise la variable Mise_à_quai. Cela veut dire, qu'il y a n'importe quoi dans Mise_à_quai après la partie Then du méga If avant le Wend. C'est difficile à voir étant donné le nombre de lignes de la boucle While contenant le If d'ajout d'une tournée.

C'est quoi le rôle de l'apostrophe devant Mise_à_quai dans cette cellule ?

3. Suggestions

Utilisez en tête du module :

Code :

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

Option Explicit

Cela force le développeur à déclarer chaque variable. C'est indispensable à ce niveau de complexité.

On notera qu'une seule variable a été déclarée :

Code :

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

Dim Réponse As Date

Cependant il ne faut pas mettre d'accent français dans les variables et procédures VBA.
On ne peut mettre des accents que dans des chaînes littérales entre double quotes :

Code :

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

Public Const nomPrefixTournee = "Tournées du "

4. Structurer le code en courtes procédures

Notez le pluriel de procédures. Il ne faudrait pas dépasser une trentaine de lignes par procédure.
Avec une seule macro à 240 lignes, le niveau de lisibilité est faible pour ne pas en rajouter davantage.

En tête de module, définir les constantes sur les noms des classeurs gérés.

Si vous regardez mes autres messages dans ce forum, vous y trouverez mon leitmotiv préféré : décrire chaque feuille avec des constantes pour les rangées et colonnes importantes mais dans ce cas, ce serait pour une étape ultérieure. Il faut commencer par structurer le code.

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
Option Explicit
Public Const nomClasseurModele = "Macro feuille de tournée.xls"
Public Const nomClasseurRecupBase = "Test recup base.xls"
Public Const nomPrefixTournee = "Tournées du "
 
' VBE menu "Outils" > "Propriété de VBA Project" > "Arguments de compilation conditionnelle"
' isNetwork=1 pour un accès réseau. isNetwork=0 ou non défini pour un accès local
#If isNetwork = 1 Then
' Utilisation en réseau
Public Const nomServeur = "\\frhosclunefs1"
Public Const nomFichierRecupBase = nomServeur + "\sitcar\Distriplanner PF\" + nomClasseurRecupBase
Public Const nomFichierBaseClient = nomServeur + "\sitcar\Clients.xls"
Public Const nomFichierTournee = nomServeur + "\sitcar\Distriplanner PF\"
#Else
' Test en local
Public Const nomRepertoire = "C:\Mes documents\Christelle\Nouveau dossier\"
Public Const nomFichierRecupBase = nomRepertoire + nomClasseurRecupBase
Public Const nomFichierBaseClient = nomRepertoire + "Clients.xls"
Public Const nomFichierTournee = nomRepertoire
#End If
 
' A partir du fichier extrait de "Distriplanner" remplir les feuilles de tournée
Sub Tournees()
Dim dateLivraison As Date, nomClasseurTournee As String
    Application.ScreenUpdating = False
'*** Récupération de la date de traitement
    On Error Resume Next ' Passe en mode de gestion d'erreur manuelle avec If Err.Number <> 0 Then ...
    dateLivraison = InputBox("Date de livraison (JJ/MM/AAAA)?", "Renseignement de la date")
    If Err.Number <> 0 Then Avertissement "1000: La date de livraison saisie est incorrecte": Exit Sub
    On Error GoTo 0 ' Restaure la gestion d'erreur automatique
 
    nomClasseurTournee = nomPrefixTournee & _
        Day(dateLivraison) & "-" & Month(dateLivraison) & "-" & Year(dateLivraison) & ".xls"
    If OuvertureClasseurs(nomClasseurTournee) Then
        CopieModeleClientTournee dateLivraison, nomClasseurTournee
        GestionTournee dateLivraison, nomClasseurTournee
    End If
    Application.ScreenUpdating = False
End Sub
 
Function OuvertureClasseurs(ByVal nomClasseurTournee As String) As Boolean
Dim nomFichierTourneeComplet As String
 
    OuvertureClasseurs = False
    On Error Resume Next ' Passe en mode de gestion d'erreur manuelle avec If Err.Number <> 0 Then ...
'*** Ouverture du fichier avec l'extraction de base de donnéees
    Workbooks.Open FileName:=nomFichierRecupBase, UpdateLinks:=0
    If Err.Number <> 0 Then Avertissement "2000: Impossible d'ouvrir " + nomFichierRecupBase: Exit Function
 
'*** Ouverture de la base clients
    Workbooks.Open FileName:=nomFichierBaseClient, UpdateLinks:=0
    If Err.Number <> 0 Then Avertissement "2100: Impossible d'ouvrir " + nomFichierBaseClient: Exit Function
'*** Ouverture d'un nouveau fichier qui servira à enregistrer les feuilles de tournée
'*** et enregistrement sous le nom "Tournées du " + la date de livraison demandée
    nomFichierTourneeComplet = nomFichierTournee + nomClasseurTournee
    Workbooks.Add
    ActiveWorkbook.SaveAs FileName:=nomFichierTourneeComplet, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    If Err.Number <> 0 Then Avertissement "2200: Impossible de sauver " + nomFichierTourneeComplet: Exit Function
    On Error GoTo 0 ' Restaure la gestion d'erreur automatique
    OuvertureClasseurs = True
End Function
 
'*** Copie des feuilles Modèle, Clients et Tournées le nouveau fichier
Sub CopieModeleClientTournee(ByVal dateLivraison As Date, ByVal nomClasseurTournee As String)
Dim feuilleCible As Worksheet
 
    With Workbooks(nomClasseurTournee)
        Set feuilleCible = .Sheets(.Sheets.Count) ' La dernière feuille
    End With
    Windows(nomClasseurModele).Activate
    Sheets("Modèle").Select
'    Sheets("Modèle").Copy After:=Workbooks(nomClasseurTournee).Sheets(3)
    Sheets("Modèle").Copy After:=feuilleCible
 
    Windows(nomClasseurModele).Activate
    Sheets("Clients").Select
    Sheets("Clients").Copy Before:=feuilleCible
 
    Range("A5").Select
    Range("D2").Value = "'" & dateLivraison
 
    Windows(nomClasseurModele).Activate
    Sheets("Tournées").Select
    Sheets("Tournées").Copy Before:=feuilleCible
    Range("A5").Select
    Range("C2").Value = "'" & dateLivraison
End Sub
 
'*** Activation du fichier d'extraction de la base de données et début du corps de la macro
Sub GestionTournee(ByVal dateLivraison As Date, ByVal nomClasseurTournee As String)
Dim Ligne_fin As Long
 
    Windows(nomClasseurRecupBase).Activate
    Sheets("TOURS").Activate
    FormatDateCol1
 
    Sheets("RANGS").Activate
    FormatDateCol1
 
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=dateLivraison
    Selection.End(xlDown).Select
    If ActiveCell.Row = 65536 Then
        Avertissement "3000: Pas de magasin à livrer à cette date!"
        Exit Sub
    End If
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    While ActiveCell <> dateLivraison
        ActiveCell.Offset(1, 0).Activate
    Wend
 
    While ActiveCell.Value <> "" And ActiveCell.Value = dateLivraison
        Magasin_a_Livrer dateLivraison, nomClasseurTournee
 
        Windows(nomClasseurRecupBase).Activate
        Sheets("RANGS").Activate
        ActiveCell.Offset(1, 0).Activate
    Wend
    ActiveWindow.Close savechanges:=False
 
    TriTourneeSauvegarde
 
    Windows(nomClasseurModele).Activate
    ActiveWindow.Close savechanges:=False
End Sub
 
Sub Magasin_a_Livrer(ByVal dateLivraison As Date, ByVal nomClasseurTournee As String)
Dim Magasin As String, Tonnage As Integer, Qte_EUT As Integer
Dim Rang As Long, Ligne As Long, Feuille As String
Dim Tournee As String, Quai As String, Transporteur As String, Chauffeur As String
Dim Tracteur As String, Remorque As String, Mise_a_quai As String, Date_depart As Date, Date_retour As Date
 
'    Magasin = Mid(ActiveCell.Offset(0, 4), 2, 5) + 0
    Magasin = Mid(ActiveCell.Offset(0, 4), 2, 5) + "0" ' Ajout de la chaîne "0" ?
    Tournee = ActiveCell.Offset(0, 2).Value
    Qte_EUT = ActiveCell.Offset(0, 7).Value
    If ActiveCell.Offset(0, 8).Value = "" Then
        Tonnage = 0
    Else
        Tonnage = ActiveCell.Offset(0, 8).Value * 1000
    End If
    Rang = ActiveCell.Offset(0, 3).Value
 
    Windows(nomClasseurTournee).Activate
    Sheets("Tournées").Select
    Range("A5").Select
    Selection.AutoFilter Field:=1, Criteria1:=Tournee
    Selection.End(xlDown).Select
    Ligne = ActiveCell.Row
    Selection.AutoFilter
    If Ligne = 65536 Then ' La tournée n'a pas été trouvée
        Selection.End(xlUp).Select
 
        Windows(nomClasseurRecupBase).Activate
        Sheets("TOURS").Select
        Range("A1").Select
        Selection.AutoFilter
        Selection.AutoFilter Field:=1, Criteria1:=dateLivraison
        Selection.AutoFilter Field:=3, Criteria1:=Tournee ' Double filtre
        Selection.End(xlDown).Select
 
        Quai = ActiveCell.Offset(0, 3).Value
        Mise_a_quai = ActiveCell.Offset(0, 4).Value
        Date_depart = ActiveCell.Offset(0, 5).Value
        Date_retour = ActiveCell.Offset(0, 6).Value
        Tracteur = ActiveCell.Offset(0, 7).Value
        Chauffeur = ActiveCell.Offset(0, 8).Value
        Remorque = ActiveCell.Offset(0, 9).Value
        Transporteur = ActiveCell.Offset(0, 10).Value
 
        AjoutTournee dateLivraison, nomClasseurTournee, _
            Tournee, Quai, Transporteur, Chauffeur, Tracteur, _
            Remorque, Mise_a_quai, Date_depart, Date_retour
    End If
 
    Windows(nomClasseurTournee).Activate
    Feuille = "" & Tournee
    Sheets(Feuille).Select
    ActiveCell.Value = Magasin
    ActiveCell.Offset(0, 4).Value = Qte_EUT
    ActiveCell.Offset(0, 5).Value = Tonnage
    ActiveCell.Offset(0, 22).Value = Rang
    ActiveCell.Offset(1, 0).Activate
    Sheets("Clients").Select
    ActiveCell.Offset(1, 0).Activate
    ActiveCell.Value = "'" & Mise_a_quai
    ActiveCell.Offset(0, 1).Value = "'" & Date_depart
    ActiveCell.Offset(0, 2).Value = Tournee
    ActiveCell.Offset(0, 3).Value = Transporteur
    ActiveCell.Offset(0, 4).Value = Magasin
    ActiveCell.Offset(0, 7).Value = Quai
End Sub
 
Sub AjoutTournee(ByVal dateLivraison As Date, ByVal nomClasseurTournee As String, _
    ByVal Tournee As String, ByVal Quai As String, ByVal Transporteur As String, _
    ByVal Chauffeur As String, ByVal Tracteur As String, ByVal Remorque As String, _
    ByVal Mise_a_quai As String, ByVal Date_depart As Date, ByVal Date_retour As Date)
Dim Position As Long, Feuille As String
 
    Windows(nomClasseurTournee).Activate
    Sheets.Add
    ActiveSheet.Name = Tournee
 
    Sheets("Modèle").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
 
    Feuille = "" & Tournee
    Sheets(Feuille).Select
    ActiveSheet.Paste
    ActiveWindow.Zoom = 50
    Application.CutCopyMode = False
    Range("A1:Z25").Select
    Range("Z25").Activate
    Application.CutCopyMode = False
 
    configurationImpression
 
    Range("B11").Select
    Range("G2").Value = "TOURNEE " & Tournee
    Range("W2").Value = "QUAI: " & Quai
    Range("C4").Value = Transporteur
    Range("C5").Value = Chauffeur
    Range("C6").Value = Tracteur
    Range("C7").Value = Remorque
    Range("G5").Value = "'" & dateLivraison
 
    DateDeMiseAQuai Mise_a_quai
 
    Range("B11").Select
    Sheets("Tournées").Select
    Range("A5").Select
    Selection.End(xlDown).Select
 
    Position = ActiveCell.Row
    If Position = 65536 Then
        Range("A6").Select
    Else
        If Position = 6 Then
            Selection.End(xlDown).Select
            Position = ActiveCell.Row
            If Position = 65536 Then
                Range("A7").Select
            Else
                ActiveCell.Offset(1, 0).Activate
            End If
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    End If
    ActiveCell.Value = Tournee
    ActiveCell.Offset(0, 1).Value = Quai
    ActiveCell.Offset(0, 2).Value = Chauffeur
    ActiveCell.Offset(0, 3).Value = Transporteur
    ActiveCell.Offset(0, 4).Value = Tracteur
    ActiveCell.Offset(0, 5).Value = Remorque
    ActiveCell.Offset(0, 6).Value = "'" & Mise_a_quai
    ActiveCell.Offset(0, 8).Value = "'" & Date_depart
    ActiveCell.Offset(0, 10).Value = "'" & Date_retour
End Sub
 
Sub DateDeMiseAQuai(ByVal Mise_a_quai As String)
Dim Jour As String, Mois As String
 
    If Mise_a_quai = "" Then
        Range("Y6").Value = "'" & Mise_a_quai
    Else
        If Day(Mise_a_quai) < 10 Then
            Jour = "0" & Day(Mise_a_quai)
        Else
            Jour = Day(Mise_a_quai)
        End If
        If Month(Mise_a_quai) < 10 Then
            Mois = "0" & Month(Mise_a_quai)
        Else
            Mois = Month(Mise_a_quai)
        End If
        Range("W6").Value = "'" & Jour & "/" & Mois & "/" & Year(Mise_a_quai)
    End If
End Sub
 
Sub TriTourneeSauvegarde()
Dim Feuille As String, Ligne_fin As Long
 
    Sheets("Tournées").Select
    Range("A6").Select
    While ActiveCell.Value <> ""
        Feuille = "" & ActiveCell.Value
        Sheets(Feuille).Select
        Range("B11:X23").Select
        Selection.Sort Key1:=Range("X11"), Order1:=xlDescending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        Columns("X:X").Delete
        Range("B11").Select
 
        Sheets("Tournées").Select
        ActiveCell.Offset(1, 0).Activate
    Wend
    Range("A6").Select
    Sheets("Clients").Select
    Range("A6").Select
    Selection.End(xlDown).Select
    Ligne_fin = ActiveCell.Row
    Range("A6:J" & Ligne_fin).Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1"), _
        Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A6").Select
    ActiveWorkbook.Save
End Sub
 
Sub FormatDateCol1()
    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("A1").Select
End Sub
 
Sub configurationImpression()
    ActiveSheet.PageSetup.PrintArea = "$A$1:$AC$25"
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
End Sub
 
Sub Avertissement(ByVal strMsg As String)
Const nbrChiffreCodeErreur = 4 ' Nombre de chiffre dans le code d'erreur. Exemple :"1000: message"
    MsgBox Mid(strMsg, nbrChiffreCodeErreur + 3), vbExclamation, _
        "Tournées : avertissement n° " + Left(strMsg, nbrChiffreCodeErreur)
End Sub

Pour certaines variables non déclarées, il m'était impossible de deviner leurs types.
J'ai choisi par défaut des String pour éviter la facilité du Variant. Il faudra affiner ces déclarations.

Vous pourrez comparer le style enregistreur de macro au kilomètre dans votre longue procédure d'origine avec cette restructuration qui peut être un point de départ si vous voulez rendre le code de cette macro progressivement compréhensible sans même parler d'optimisation.

A partir du point d'entrée inchangé Tournees() sans accent puisque c'est du VBA, on a isolé l'OuvertureClasseurs().
On a ajouté une gestion d'erreurs minimale pour contrôler la date et l'ouverture des classeurs.

Si cette ouverture s'est bien passée alors on peut copier le modèle par : CopieModeleClientTournee().
Viens ensuite GestionTournee() avec sa boucle While sur Magasin_a_Livrer() puis le tri final TriTourneeSauvegarde().

Magasin_a_Livrer() recherche si la tournée existe.
Si la tournée n'existe pas pour la date de livraison donnée, une nouvelle feuille est créée par AjoutTournee().

5. Tester immédiatement la procédure d'erreur Avertissement()

Dans la fenêtre d'Exécution immédiate (Ctrl+G) du VBE, copier-coller et valider par ENTER :

Code :

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

Avertissement "9000: configurationImpression a échoué"

Cela affiche une boite de dialogue avec le message d'erreur et montre comment utiliser un code d'erreur --toujours à quatre chiffres-- en tête du message d'erreur.

6. Double AutoFilter

Pouvez-vous donner un extrait le plus minimal possible de la feuille "TOURS" du classeur Test recup base.xls afin de faire fonctionner le second AutoFilter avec comme critère Tournee.

Code :

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

1
2
3
4
5
6
Sheets("TOURS").Select
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=dateLivraison
Selection.AutoFilter Field:=3, Criteria1:=Tournee ' Double filtre
Selection.End(xlDown).Select

J'ai essayé de mettre les valeurs suivantes dans une feuille de test dénommée Test recup base.xls

Code :

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

1
2
3
11/12/2011      Tournee1
12/12/2011      Tournee2
15/12/2011      Tournee3

Le premier filtre fonctionne bien avec les dates de A1 à A3.
J'ai également essayé de mettre des dates en colonne C.
Que faut-il mettre de C1 à C... pour que le second filtre consécutif puisse marcher ?
___________

Si la discussion est résolue, vous pouvez cliquer sur le bouton

En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert

ci-dessous.

**kiki29** · 05/08/2011, 01h16

Salut, accessoirement et pour plus tard voir http://www.developpez.net/forums/d55...ge-macros-xl4/ pour accélérer la mise en page pour Excel <=2007, sous 2010 il y aurait

Code :

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

1
2
3
4
 
Application.PrintCommunication = False
.....
Application.PrintCommunication = True

**Babybel54** · 05/08/2011, 14h03

Enorme merci, je vais tout étudier.
Ca a du te prendre du temps, je regarde tout ça et te dit si cela vient de là.

Une macro se lance sur un PC mais sur un autre non.

Macros et VBA Excel

Discussions similaires

Partager

Partager