Macro et classeur partagé

Version imprimable

21/02/2014, 19h18
ericdev67

Macro et classeur partagé

Bonjour,

Galère…j'ai un classeur avec différentes macros (merci pour toutes les aides du forum !), mais ce classeur peut être ouvert par différentes personnes en même temps.

J'ai donc mis ce classeur en "partage", mais les macros ne fonctionnent plus….

En allant sur la FAQ, je lis que le classeur "partagé" n'accepte pas les macros, dont acte…mais j'ai aussi lu "vous pouvez enregistrer dans une macro des opérations effectuées dans un classeur partagé"….et je ne comprends pas….du moins, je ne vois pas comment faire…..

J'ai essayé d'enregistrer mon classeur en fichier WEB, me permettant une ouverture multiutilisateurs, mais je n'arrive pas à faire tourner mes macros…

Bref, je suis en galère car ce classeur contient mes macros, tout fonctionne parfaitement, mais je ne sais pas comment faire pour que 2,3,4,etc…utilisateurs puissent l'utiliser en même temps…..

Une idée, une aide ?

Merci,

A+
22/02/2014, 08h31
jijie

Bonjour,

Sans parler des macros, si un classeur est ouvert par plusieurs personnes en même temps et que ces personnes inscrivent des opérations pour alimenter des ou une table(s), ce n'est donc pas possible.

Par contre dans ton cas je pense que tu souhaite que les personnes utilisent ce classeur avec macro pour leurs offrir les services de celui-ci par les macros que tu a réalisé mais sans rien inscrire dans les tables !?? Si c'est le cas tu devrais créer autant de classeurs identique pour chaque personne qui l'utilise et avec les macros et par un classeurs qui seulement toi tu est maître pour alimenter les tables de chaque classeurs et ce par macro !
22/02/2014, 09h22
ericdev67

Merci Jijie,

J'avais pensé à cette solution : le classeur, par collègue, que chaque collègue alimente, et moi, par macro, je "récupère" les données.

Pour expliquer mon cas : le classeur est un classeur de fiche de frais (par exemple). Chaque collègue a son propre classeur, met ses montants de frais (saisie grâce à userform, qui alimente des lignes d'un tableau). Donc je peux créer un tableau "général" qui reprend toutes les données et lignes des tableaux de chaque collègues (ils sont 20).

Je peux donc envisager de créer une macro dans mon classeur "général", qui boucle sur tous les tableaux des collègues et qui rapatrie les données, puisqu'en classeur partagé on ne peut avoir de macro….

Mais question : si le collègue garde son classeur ouvert, et que je lance ma macro du "général", je vais certainement avoir le message "classeur déjà ouvert", et donc, ne pourrait pas rapatrier les données ?….

L'autre solution étant de faire l'inverse : la macro du classeur de chaque collègue peut alimenter le classeur "général", mais s'il est déjà ouvert, j'aurai aussi le message "classeur déjà ouvert"….

Dernière solution (qui je pense est faisable) : faire un classeur "général", sans macro et partagé. Lorsque le collègue ouvre son classeur, fait tourner sa macro, elle "écrit" les données dans le classeur partagé et moi, je crée un classeur avec macro qui "récupère" les données dans le classeur "général"…..

C'est cette solution que tu me proposais ?

Merci,

A+
22/02/2014, 16h39
jijie

Salut,

Citation:

C'est cette solution que tu me proposais ?

Ds mon post je te parlais de la solution 2 que tu propose! Mais en te lisant, je pense qu'effectivement c'est bien ta troisième et dernière solution qui me semble être la meilleur et surtout la plus sûre!

Donc reste encore du travail !!
22/02/2014, 17h29
Marc-L

Bonjour,

normalement, même si un classeur est ouvert par un utilisateur,
rien n'empêche de l'ouvrir en lecture seule via le réseau depuis un autre poste
puis d'exporter les données dans un fichier texte voir de les importer directement …
22/02/2014, 17h38
jijie

Salut Marc,

Donc tu confirme bien qu'il est possible de lire et écrire ds un fichier ouvert?

Tu pourrais nous envoyer un lien pour ma simple documentation ?

MERCI
22/02/2014, 17h58
Marc-L

Pour l'écriture dans un fichier partagé déjà ouvert, je dirais non pour l'instant
car je ne retrouve pas de cas concret et par expérience et
retours sur des forums du monde entier, j'ai trop vu de galères !

Quant à la lecture, si on applique au moins la base de tout langage,
c'est à dire la consultation de sa documentation, pour VBA son aide intégrée,
la méthode Open de la collection Workbooks a bien un paramètre pour la lecture seule !
A tenter donc …

Si dans cet environnement réseau cela ne fonctionne pas (rien que les droits d'accès …)
reste la possibilité d'exporter un fichier texte par l'utilisateur par exemple
puis de le copier sur le réseau ou l'envoyer par mail, etc …
Reste ensuite au responsable exécutif de l'applicatif d'importer les fichiers de chacun des utilisateurs …

L'export / import est facile sous Excel, il faut plutôt penser aux contrôles …
En général j'ai deux - trois lignes pour l'export ou l'import d'un fichier
mais je peux en avoir dix à vingt fois plus pour les contrôles !

Peut-être aussi une solution via une connexion ADODB
mais je ne sais si c'est possible en réseau sur un fichier ouvert …
Robert Durupt si tu me lis, tes lumières, même assombries, sont les bienvenues !
Idem pour tout autre éclairé en la matière …

Merci Jijie,
Merci Marc-L,

J'ai essayé avec
Code:

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 Sub miseAJour_Enregistrement() Dim Cn As ADODB.Connection Dim Fichier As String, Feuille As String, strSQL As String Dim PrixUnit As Integer Dim leNom As String Fichier = "C:\Base.xls" Feuille = "Feuil1" leNom = "NomTest" PrixUnit = 45 Set Cn = New ADODB.Connection With Cn .Provider = "MSDASQL" .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _ "DBQ=" & Fichier & "; ReadOnly=False;" .Open End With 'Met à jour la valeur du "Champ4" si le "Champ2" correspond à la variable "leNom" strSQL = "UPDATE [" & Feuille & "$] SET " & _ "Champ4 = " & PrixUnit & " WHERE Champ2 = '" & leNom & "'" Cn.Execute strSQL Cn.Close Set Cn = Nothing End Sub
trouvé sur la FAQ….cela fonctionne parfaitement (à la maison) : j'ai laissé le classeur "Base.xls" ouvert et de mon classeur "général" j'ai fait tourner le code, cela a bien mis le champ2 à jour, sans problème (=style message d'erreur "classeur déjà ouvert")….malheureusement je ne pourrai pas l'essayer avant lundi (retour boulot)…..mais j'ai l'impression que c'est en bonne voie….

Effectivement, ça va être un peu galère Jijie, car je pense qu'il va falloir que je mette ce code dans le classeur du collègue, pour alimenter "Base.xls" et idem dans mon classeur "général".

Suspens….

Qu'en pensez-vous ?

Merci,
A+

24/02/2014, 09h44
bboy-eazy

Bonjour,

Pouvez vous envoyer les macros que vous avez dans votre classeur svp car les macros fonctionnent très bien même si le claseur est partagé.

J'ai plein de classeurs partagés et toutes mes macros fonctionnent que ce soit une connection ADODB à l'ouverture ou même la mise en place d'une barre personnalisée et même la protection de valeur ...

Alors où est ce que ca bloque chez vous lorsque vous partagez le classeur?

Merci bboy-eazy,

J'ai mis la macro dans mon dernier post.

Je ré-explique ce que je fais (et qui ne fonctionne pas....)

Classeur A : "Base" : contient toutes les données sous forme de liste (liste que je partage avec 20 collègues) Il s'agit de notes de frais.
Classeur B : "Classeur Eric" : contient toutes les données me concernant (=tous mes frais)

Dans le classeur B ("Classeur Eric"), j'ai mis le code
Code:

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 Sub miseAJour_Enregistrement() Dim Cn As ADODB.Connection Dim Fichier As String, Feuille As String, strSQL As String Dim PrixUnit As Integer Dim leNom As String Fichier = "C:\Base.xls" Feuille = "Feuil1" leNom = "Eric" PrixUnit = 45 Set Cn = New ADODB.Connection With Cn .Provider = "MSDASQL" .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _ "DBQ=" & Fichier & "; ReadOnly=False;" .Open End With 'Met à jour la valeur du "Champ4" si le "Champ2" correspond à la variable "leNom" strSQL = "UPDATE [" & Feuille & "$] SET " & _ "Champ4 = " & PrixUnit & " WHERE Champ2 = '" & leNom & "'" Cn.Execute strSQL Cn.Close Set Cn = Nothing End Sub
Là, cela fonctionne, le classeur A ("Base") est mis à jour.

Par contre, si le classeur A est ouvert par un collègue (par exemple, la compta qui regarde les frais), le Champ4 n'est pas mis à jour.....

J'ai essayé en mettant "Base" en classeur partagé, idem, cela ne met pas le fichier à jour automatiquement s'il est ouvert. et quand la compta ferme le classeur (partagé), seules ses informations sont sauvegardées..et pas les miennes.

J'ai aussi essayé en ne mettant pas le classeur A en partagé, et naturellement, le dernier "enregistreur" écrase les données.....

Bref, suis un peu perdu.......:?

Merci,
A+

24/02/2014, 22h11
clementmarcotte

Bonjour,

Il est impossible que deux personnes puissent écrire en même temps dans un classeur Excel, partagé ou non. Seule la première personne qui a ouvert le classeur peut écrire dans le classeur. Tous les autres utilisateurs n'ont accès au classeur qu'en lecture seule. Ceci est, comme disent les anglos "by desing". La seule solution est d'attendre son tour pour disposer du statut de premier utilisateur. C'est pour cela qu'il y a généralement une boîte de dialogue qui s'affiche quand le classeur est déjà ouvert et que le choix est clair: ouvrir en lecture seule, ou attendre le message que le classeur est disponible.

Excel n'est pas un SGBD et n'est pas conçu pour la gestion de données. Il n'a rien pour gérer les mises à jour simultanées et le problèmes de "collisions" et autres.

bonjour,

ALors moi n'étant pas un grand maitre du vBA mais je vous met en PJ les fichiers qu'on utilise pour le suivi de progression des contrôle des lots fabriqués:

L'un n'est pas partagé mais l'autre l'est et est ouvert par environ 10 ordinateurs sans aucun problème de pertes de données etc... Je vous laisse regarder les macros présentent car je ne pourrais pas vous aider autrement. Par contre désolé mais la taille du fichier Excel est trop grande poour que je puisse mettre en PJ....

Voici ce qui est placé dans le module du fichier non partagé et qui transfert les données entrées dans un fichier partagé
nommé Suivi_Lots

Code:

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
348
349
350
351
352
353
354
355
356
357
Public N As Integer
Public C As Integer
Public R As Integer
Public Lot As Long
Public TROUVE As Boolean
Public ENREGAUTO As Boolean
Public FERMETURE As Boolean
Public LOTCHRCHE As Range
Public Debut As Date
Public Jour As Variant
Public MODIF As Boolean
 
Sub Export()
Dim T As Boolean
T = False
If Not (ThisWorkbook.ReadOnly) Then
On Error GoTo Fin
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("SUIVI_LOTS.xls").Save
 
Calculate
 
'Comptage du nombre de ligne dans la liste auto-qualité
Comptage
 
'Comptage des lots non-auto-qualité dans la liste CQ
Dim i As Integer
i = 4
 
'Tri des lots non-auto-qualité dans la liste CQ
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("A4:BV2000").Sort Key1:=Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
i = Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Cells(1, 2).Value + 4
 
'Transfert des données Stérilité vers Programme CQ
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("A" & i & ":C2000").ClearContents
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("A" & i & ":C" & i + N - 3).Value = ThisWorkbook.Sheets("Liste").Range("B" & 3 & ":D" & N).Value
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("E" & i & ":F2000").ClearContents
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("E" & i & ":F" & i + N - 3).Value = ThisWorkbook.Sheets("Liste").Range("E" & 3 & ":F" & N).Value
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("H" & i & ":H2000").ClearContents
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("H" & i & ":H" & i + N - 3).Value = ThisWorkbook.Sheets("Liste").Range("H" & 3 & ":H" & N).Value
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("J" & i & ":N2000").ClearContents
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("J" & i & ":N" & i + N - 3).Value = ThisWorkbook.Sheets("Liste").Range("J" & 3 & ":N" & N).Value
Workbooks("SUIVI_LOTS.xls").Save
T = True
End If
Fin:
If T = False Then
X = MsgBox("Le transfert automatique des données vers le CQ a échoué.", vbExclamation)
End If
End Sub
 
Sub Comptage()
N = ThisWorkbook.Worksheets("Liste").Cells(1, 16).Value
N = N + 3
End Sub
 
'Saisie d'un nouveau lot
Sub Macro1()
Application.ScreenUpdating = False
Worksheets("Planning").Unprotect Password:="123456"
Worksheets("Liste").Unprotect Password:="123456"
MODIF = True
R = 5
Nouvelle_Saisie.Show
MODIF = False
Worksheets("Planning").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123456"
Worksheets("Liste").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123456"
End Sub
 
'Modification de la date de fin et/ou modification du statut du dossier
Sub Macro2()
Application.ScreenUpdating = False
If R >= 5 And R <= 50 Then
Worksheets("Planning").Unprotect Password:="123456"
Worksheets("Liste").Unprotect Password:="123456"
MODIF = True
DateFin.Show
ActiveSheet.Cells(1, C).Select
MODIF = False
Worksheets("Planning").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123456"
Worksheets("Liste").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123456"
End If
End Sub
 
' MAJ de la date de fin réelle + statut du dossier
Sub Macro_Fin()
Application.ScreenUpdating = False
Dim i, j As Integer
j = 5
TROUVE = False
 
'Recherche du jour correspondant
If C >= 2 And C <= 8 Then
C = 2
ElseIf C >= 9 And C <= 15 Then
C = 9
ElseIf C >= 16 And C <= 22 Then
C = 16
ElseIf C >= 23 And C <= 29 Then
C = 23
ElseIf C >= 30 And C <= 36 Then
C = 30
ElseIf C >= 37 And C <= 43 Then
C = 37
ElseIf C >= 44 And C <= 50 Then
C = 44
End If
 
If (Worksheets("Planning").Cells(R, C) = VIDE And Lot <> VIDE) Or (Not IsEmpty(LOTCHRCHE) And Lot <> 0) Then
    While Worksheets("Planning").Cells(j, C + 1) <> VIDE
        If Worksheets("Planning").Cells(j, C + 1) = Lot Or Worksheets("Planning").Cells(j, C + 1) = LOTCHRCHE.Value Then
        R = j
        TROUVE = True
        GoTo Fin
        End If
    j = j + 1
    Wend
j = 5
Else
TROUVE = True
End If
Fin:
End Sub
 
Sub Priorities()
Application.ScreenUpdating = False
Dim A As Integer
Dim B As Integer
Dim C As Integer
 
Workbooks("SUIVI_LOTS.xls").Save
A = Worksheets("Liste").Cells(1, 16).Value
'Nb de lots non autoqualité
B = Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Cells(1, 2).Value
'Nb de lots autoqualité
C = Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Cells(1, 3).Value
Worksheets("Liste").Unprotect Password:="123456"
 
'Tri des lots non-auto-qualité dans la liste CQ
Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("A4:BV2000").Sort Key1:=Workbooks("SUIVI_LOTS.xls").Sheets("Liste PETRI").Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
If ThisWorkbook.ReadOnly Then
ENREGAUTO = True
End If
MODIF = True
 
If A <> 0 Then
Worksheets("Liste").Range("A3:A" & 2 + A).Value = Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("D" & 4 + B & ":D" & 4 + C).Value
Worksheets("Liste").Range("O3:O" & 2 + A).Value = Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("BQ" & 4 + B & ":BQ" & 4 + C).Value
End If
Worksheets("Liste").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123456"
 
Worksheets("Urgences").PivotTables("Tableau croisé dynamique1").RefreshTable
ENREGAUTO = True
MODIF = False
If Not (ThisWorkbook.ReadOnly) Then
    ThisWorkbook.Save
    ENREGAUTO = False
End If
End Sub
 
Sub Archivage()
Dim Chemin1, Chemin2, Chemin3 As Variant
Chemin1 = Workbooks("SUIVI_LOTS.xls").Path & "\" & Workbooks("SUIVI_LOTS.xls").Name
Chemin2 = Worksheets("Paramètres").Cells(16, 3).Value
Chemin3 = ThisWorkbook.Path
 
'Archivage permis seulement entre 20:30 et 5:00 pour réduire le risque de conflit
If Not (ThisWorkbook.ReadOnly) And ((Time > 0.84375 And Ime < 0.989999999) Or (Time > 0.000000001 And Time < 0.16666667)) And Chemin1 = Chemin2 And Chemin3 = "X:\_SUIVI DE LOTS\01-AUTOQUALITE" Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
X = MsgBox("L'opération d'archivage est une opération critique et peut prendre plusieurs minutes. Merci ne pas effectuer d'autres tâches sur le poste pendant cette opération pour assurer son bon déroulement.", vbExclamation)
 
'================================== ARCHIVAGE DES DONNEES T&F ==================================================================================================================================================================
 
'Vérifier que le fichier stérilité T&F n'est pas déjà ouvert
Dim lWorkbook As Workbook
Dim Found, Ouvert As Boolean
Found = False
For Each lWorkbook In Workbooks
    If lWorkbook.Name = "Saisie Stérilité T&F.xls" Then
        Found = True
        Exit For
    End If
Next
If Found = False Then
    Workbooks.Open Filename:= _
            "" & Worksheets("Paramètres").Cells(19, 3) & "", WriteResPassword:="sandrine"
    'S'il n'est pas en lecture seule, lancer l'archivage
    If Not (Workbooks("Saisie Stérilité T&F.xls").ReadOnly) Then
        Workbooks("Saisie Stérilité T&F.xls").Worksheets("Liste").Activate
        Application.Run "'Saisie Stérilité T&F.xls'!Archivage"
        Workbooks("SUIVI_LOTS.xls").Save
        Workbooks("Saisie Stérilité T&F.xls").Save
        Workbooks("Saisie Stérilité T&F.xls").Close
    Else
        'Dans le cas où le fichier T&F est ouvert
        Workbooks("Saisie Stérilité T&F.xls").Close
        Ouvert = True
        X = MsgBox("Le fichier de saisie du secteur Tubes & Flacons étant actuellement en cours d'utilisation, l'archivage ne peut pas être effectué. Merci de réessayer ultérieurement", vbCritical)
        GoTo Fin
    End If
End If
 
'================================== ARCHIVAGE DES DONNEES PETRI ==================================================================================================================================================================
Dim i, j As Integer
i = 3
j = 0
Dim Nom As Variant
 
'Enregistrement des différents fichiers + MAJ des statuts des lots
ThisWorkbook.Activate
Priorities
 
'Suppression des données dans le fichier Autoqualité
MODIF = True
Worksheets("Liste").Unprotect Password:="123456"
While Worksheets("Liste").Cells(i, 15).Value = "" And i < 2000
    i = i + 1
Wend
If i <> 2000 Then
    Selection.AutoFilter Field:=15, Criteria1:="<>"
    Worksheets("Liste").Range("A" & i & ":B2001, D" & i & ":F2001, H" & i & ":H2001, J" & i & ":O2001").ClearContents
    Selection.AutoFilter Field:=15
    Worksheets("Liste").Range("A3:O1499").Select
    Selection.Sort Key1:=Range("C3"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Worksheets("Liste").Range("A1").Select
    Worksheets("Liste").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123456"
Else
    Worksheets("Liste").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123456"
    X = MsgBox("Opération d'archivage terminée avec succès", vbOKOnly)
    GoTo Fin
End If
 
'Archivage des données dans le fichier Suivi_Lots --> Liste PETRI
Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Activate
Application.Run "SUIVI_LOTS.xls!Archives_Debut"
'Enlever le partage pendant l'archivage et éviter un conflit si quelqu'un d'autre l'avait laissé ouvert
Workbooks("SUIVI_LOTS.xls").ExclusiveAccess
i = 4
While Worksheets("Liste PETRI").Cells(i, 69).Value = "" And i < 3000
    i = i + 1
Wend
If i <> 3000 Then
    'Ouverture du fichier d'Archives
    Workbooks.Open Filename:= _
            "" & ThisWorkbook.Worksheets("Paramètres").Cells(18, 3) & "", WriteResPassword:="history"
    Nom = ActiveWorkbook.Name
    Workbooks(Nom).Worksheets("Liste PETRI").Activate
    j = Worksheets("Liste PETRI").Cells(1, 3).Value + 4
 
    'Copie des données dans le fichier d'archives
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Activate
    ' A supprimer dans la version définitive
    Columns("A:BV").Select
    Selection.EntireColumn.Hidden = False
    Selection.AutoFilter Field:=69, Criteria1:="<>"
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("A" & i & ":D3001").Copy
    Workbooks(Nom).Activate
    Range("A" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("E" & i & ":G3001").Copy
    Workbooks(Nom).Activate
    Range("F" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("J" & i & ":L3001").Copy
    Workbooks(Nom).Activate
    Range("I" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("O" & i & ":O3001").Copy
    Workbooks(Nom).Activate
    Range("L" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("P" & i & ":S3001").Copy
    Workbooks(Nom).Activate
    Range("N" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("U" & i & ":AD3001").Copy
    Workbooks(Nom).Activate
    Range("R" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("AF" & i & ":AO3001").Copy
    Workbooks(Nom).Activate
    Range("AB" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("AQ" & i & ":AZ3001").Copy
    Workbooks(Nom).Activate
    Range("AL" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("BB" & i & ":BL3001").Copy
    Workbooks(Nom).Activate
    Range("AV" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("BM" & i & ":BP3001").Copy
    Workbooks(Nom).Activate
    Range("BH" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("BQ" & i & ":BV3001").Copy
    Workbooks(Nom).Activate
    Range("BM" & j).Select
    Selection.PasteSpecial Paste:=xlValues
 
    'Remise en forme de l'onglet Liste PETRI
    Workbooks("SUIVI_LOTS.xls").Activate
    Worksheets("Liste PETRI").Activate
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("A" & i & ":F3001, H" & i & ":H3001, J" & i & ":S3001, U" & i & ":AD3001, AF" & i & ":AO3001, AQ" & i & ":AZ3001, BB" & i & ":BV3001").ClearContents
    Selection.AutoFilter Field:=69
    Workbooks("SUIVI_LOTS.xls").Worksheets("Liste PETRI").Range("A4:BV2999").Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    ' A supprimer dans la version définitive
    Application.Run "SUIVI_LOTS.xls!Mise_en_Forme_PETRI"
 
    'Enregistrer immédiatement pour limiter les risques de conflits
    ThisWorkbook.Activate
    ThisWorkbook.Save
    Workbooks(Nom).Activate
    Application.Run Nom & "!Mise_en_Forme_PETRI"
    Workbooks(Nom).Save
    Workbooks(Nom).Close
End If
 
MODIF = False
X = MsgBox("Opération d'archivage terminée avec succès", vbOKOnly)
 
Workbooks("SUIVI_LOTS.xls").KeepChangeHistory = False
Workbooks("SUIVI_LOTS.xls").SaveAs Filename:= _
    "\\Frmant02\Ctrlbact\_SUIVI DE LOTS\SUIVI_LOTS.xls", AccessMode:=xlShared
Application.Run "SUIVI_LOTS.xls!Archives_Fin"
Application.Run "SUIVI_LOTS.xls!Supp_barre_boutons"
Application.Windows("SUIVI_LOTS.xls").Visible = False
 
Fin:
Else
    If (Chemin1 <> Chemin2) Or Chemin3 <> "X:\_SUIVI DE LOTS\01-AUTOQUALITE" Then
        X = MsgBox("Le fichier utilisé actuellement n'est pas placé au bon endroit. Veuillez fermer, puis réouvrir le fichier immédiatement.", vbCritical)
    Else
        X = MsgBox("L'archivage ne peut pas être effectué dans cette plage horaire de la journée", vbCritical)
    End If
End If
 
End Sub

25/02/2014, 19h16
ericdev67

Merci bboy-eazy,

J'ai regardé ton code, et je pense que le fait de pouvoir lire/écrire dans le classeur sans problème, se situe dans les lignes 178 et 209 : si le classeur est déjà ouvert, il ne fait pas la mise à jour et met un message d'alerte.

C'est peut-être la solution….je peux envisager de mettre une boucle =je regarde si le classeur est déjà ouvert, si oui, je mets une boucle temporelle de 5 minutes, par exemple, et je retente l'opération, et ainsi de suite…..c'est une idée…..

~~Y en a-t-il d'autres ?~~

J'ai essayé et cela fonctionne parfaitement......

merci,

A+ pour de prochaines aventures....