formatage automatique des cellules

**Patate3181** · 28/05/2024, 09h32

Bonjour à tous,

Je me permets de venir vous solliciter aujourd'hui pour réaliser une optimisation si c'est possible. (Je n'ai pas réussi à trouver d'équivalent sur le forum)

J'ai un code qui fonctionne et qui réalise ce que je souhaites cependant il est extrêmement lent et pose quelques problématiques sur le remplissage.

Je vous présente l'objectif :

J'ai une équipe de 150 personnes (Pas tous très à l'aise avec l'outil informatique) qui doivent remplir un rapport sur Excel. Ce rapport doit pouvoir :

1. encaisser des copier coller de tout type, de toute provenance, et de toute forme et le mettre dans un formalisme convenable. Bien évidemment, la cellule doit pouvoir être re modifiable par la suite.
2. La cellule doit s'adapter au contenu du coup je n'ai pas utilisé la fonction fusionner mais "Centrer sur plusieurs colonnes" cependant ça force à écrire sur la cellule de gauche ce qui ergonomiquement parlant n'est pas ultra parfait.

Je suis donc ouvert à toutes suggestions d'améliorations mon but est d'apprendre et de m'améliorer j'ai réalisé ce code en farfouillant sur internet et en adaptant donc il n'est pas parfait merci de votre indulgence et au plaisir de vous lire

PS: J'ai oublié de préciser mais sur cette feuille le code que vous trouverez ci dessous existe en 13 fois. Je l'ai donc dupliqué à chaque fois, je n'ai pas réussi à les fusionner

Code pour une cellule :

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
 
Set KeyCells = Range("D7:H7")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Societe_Auditee.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D7:H7").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D7").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If

Nom : image_2024-05-28_093159185.png
Affichages : 127
Taille : 75,3 Ko

Au besoin je pourrai joindre une partie du fichier en attendant, je peux vous proposer une image afin que vous ayez une visualisation esthétique

Merci et belle journée !

**Philippe Tulliez** · 28/05/2024, 10h01

Bonjour,
Le code publié semble provenir d'une procédure événementielle, il serait intéressant de savoir laquelle.
Quel objet est Form_Societe_Auditee, un objet Range je suppose mais quelle adresse ?

**Patate3181** · 28/05/2024, 10h19

Toutes mes excuses !

Il s'agit de la cellule D7 qui contient la valeur de la société auditée.

J'ai décidé de déclarer en variable mes cellules pour rendre le code plus lisible plutôt qu'avoir Range("D7"). De la sorte dans mon select case je sais directement ce que je regarde !

**Philippe Tulliez** · 28/05/2024, 10h38

Bonjour,
Vous n'avez pas répondu à toutes mes questions.
Ce code se trouve dans quelle procédure événementielle ?
Pourquoi ne pas publier la procédure complète de Sub à End Sub ?

J'ai décidé de déclarer en variable mes cellules pour rendre le code plus lisible plutôt qu'avoir Range("D7"). De la sorte dans mon select case je sais directement ce que je regarde !

C'est une très bonne pratique mais si vous ne commentez pas ce que vous publiez, ll est impossible de vous aider sérieusement

**Patate3181** · 28/05/2024, 10h56

C'était pour plus de lisibilité étant donné qu'elle est répétitive, je voulais pas noyer l'information principale.

La macro est dans la worksheet change car je souhaite la mettre à jour lorsqu'ils écrivent au fur et à mesure.

Je fais de plus appel à une sub annexe qui déclare toutes mes variables

Voici toutes les subs de ma sheet, ainsi que ma sub variable :

Variables :

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
Option Explicit
'Feuilles
Public Ws_Plan, Ws_Cloture, Ws_Couverture, Ws_Informations, Ws_Presence, Ws_Rapport, Ws_Conclusion, Ws_NC, Ws_Plan_J2, Ws_Plan_J3, Ws_Plan_J4 As Worksheet
'Plages / Cellules'Propriete de Qualitia Certification
Public IND_01_OF, IND_01_CBC, IND_01_VAE, IND_01_CFA, IND_02_OF, IND_02_CBC, IND_02_VAE, IND_02_CFA, IND_03_OF, IND_03_CBC, IND_03_VAE, IND_03_CFA, IND_04_OF, IND_04_CBC, IND_04_VAE, IND_04_CFA _
, IND_05_OF, IND_05_CBC, IND_05_VAE, IND_05_CFA, IND_06_OF, IND_06_CBC, IND_06_VAE, IND_06_CFA, IND_07_OF, IND_07_CBC, IND_07_VAE, IND_07_CFA, IND_08_OF, IND_08_CBC, IND_08_VAE, IND_08_CFA, IND_09_OF _
, IND_09_CBC, IND_09_VAE, IND_09_CFA, IND_10_OF, IND_10_CBC, IND_10_VAE, IND_10_CFA, IND_11_OF, IND_11_CBC, IND_11_VAE, IND_11_CFA, IND_12_OF, IND_12_CBC, IND_12_VAE, IND_12_CFA, IND_13_OF, IND_13_CBC _
, IND_13_VAE, IND_13_CFA, IND_14_OF, IND_14_CBC, IND_14_VAE, IND_14_CFA, IND_15_OF, IND_15_CBC, IND_15_VAE, IND_15_CFA, IND_16_OF, IND_16_CBC, IND_16_VAE, IND_16_CFA, IND_17_OF, IND_17_CBC, IND_17_VAE _
, IND_17_CFA, IND_18_OF, IND_18_CBC, IND_18_VAE, IND_18_CFA, IND_19_OF, IND_19_CBC, IND_19_VAE, IND_19_CFA, IND_20_OF, IND_20_CBC, IND_20_VAE, IND_20_CFA, IND_21_OF, IND_21_CBC, IND_21_VAE, IND_21_CFA _
, IND_22_OF, IND_22_CBC, IND_22_VAE, IND_22_CFA, IND_23_OF, IND_23_CBC, IND_23_VAE, IND_23_CFA, IND_24_OF, IND_24_CBC, IND_24_VAE, IND_24_CFA, IND_25_OF, IND_25_CBC, IND_25_VAE, IND_25_CFA, IND_26_OF _
, IND_26_CBC, IND_26_VAE, IND_26_CFA, IND_27_OF, IND_27_CBC, IND_27_VAE, IND_27_CFA, IND_28_OF, IND_28_CBC, IND_28_VAE, IND_28_CFA, IND_29_OF, IND_29_CBC, IND_29_VAE, IND_29_CFA, IND_30_OF, IND_30_CBC _
, IND_30_VAE, IND_30_CFA, IND_31_OF, IND_31_CBC, IND_31_VAE, IND_31_CFA, IND_32_OF, IND_32_CBC, IND_32_VAE, IND_32_CFA, IND_E1, IND_E2, IND_E3, IND_E4, INF_OF, INF_CBC, INF_VAE, INF_CFA, NC_OF, NC_CBC _
, NC_VAE, NC_CFA, Col_GEN, Col_NE, Col_CNEFOP, Col_SURV, Type_Audit, Lg_Caract_Site, Caract_Site, Multi_Site, Modalite_Audit, Moyens_utilises, Tic_utilise, Presta_OF, Presta_CBC, Presta_VAE, Presta_CFA _
, Plan_Fct_Ctrl, PlanJ2_Fct_Ctrl, PlanJ3_Fct_Ctrl, PlanJ4_Fct_Ctrl, Lg_Multi_Site, Duree_Audit, KeyCells, xRg, feuil_Active, Date_Debut, Date_Fin As Range
 
Public Form_Societe_Auditee, Form_Correspondant, Form_Responsable_Audit, Form_Type_Audit, Form_Modalites, Form_Num_Affaire, Form_Mail_Audite, Form_Tel_Audite, Form_Mail_Auditeur, Form_Tel_Auditeur _
, Form_Observateur, Form_Adresse_Siege, Form_Lieu_Audit_1, Form_Lieu_Audit_2, Form_Lieu_Audit_3, Form_Lieu_Audit_4, Form_Evolutions, Form_Points_Forts, Form_NC_Contestees, Form_Info_OPAC, Form_Presta_OF _
, Form_Presta_CBC, Form_Presta_VAE, Form_Presta_CFA, Form_Justification, plage, c, x, Audit_I, Audit_S, Audit_R, Audit_C, Audit_E, P_Audit, Fct_ctrl, Site_ech, verif_fct_ctrl As Range
 
'Checkbox'Propriete de Qualitia Certification
Public Check_CNEFOP, Check_NE_OF, Check_NE_CBC, Check_NE_VAE, Check_NE_CFA, Check_OF, Check_CBC, Check_VAE, Check_CFA As Variant
 
Public I, J, K, L As Long
 
Public Sub Initialisation() 'Propriete de Qualitia Certification
 
On Error Resume Next
 
''-------------------------------------------------------------------------------------------PARAMETRES
'------------------------------------------------------IDENTIFICATION DES FEUILLES
Set Ws_Plan = Worksheets(2)
Set Ws_Plan_J2 = Worksheets(3)
Set Ws_Plan_J3 = Worksheets(4)
Set Ws_Plan_J4 = Worksheets(5)
Set Ws_Cloture = Worksheets(6)
Set Ws_Couverture = Worksheets(7)
Set Ws_Informations = Worksheets(8)
Set Ws_Presence = Worksheets(9)
Set Ws_Rapport = Worksheets(10)
Set Ws_Conclusion = Worksheets(11)
Set Ws_NC = Worksheets(12)
'Propriete de Qualitia Certification
'------------------------------------------------------IDENTIFICATION DES CELLULES
 
Set Form_Societe_Auditee = Ws_Plan.Range("D7")
Set Form_Correspondant = Ws_Plan.Range("D9")
Set Form_Responsable_Audit = Ws_Plan.Range("D11")
Set Form_Type_Audit = Ws_Plan.Range("D13")
Set Form_Modalites = Ws_Plan.Range("D15")
Set Form_Num_Affaire = Ws_Plan.Range("L7")
Set Form_Mail_Audite = Ws_Plan.Range("K9")
Set Form_Tel_Audite = Ws_Plan.Range("K11")
Set Form_Mail_Auditeur = Ws_Plan.Range("K13")
Set Form_Tel_Auditeur = Ws_Plan.Range("K15")
Set Form_Observateur = Ws_Plan.Range("K17")
Set Form_Adresse_Siege = Ws_Plan.Range("D36")
Set Form_Lieu_Audit_1 = Ws_Plan.Range("D49")
Set Date_Debut = Ws_Plan.Range("D51")
Set Date_Fin = Ws_Plan.Range("G51")
 
Set Form_Lieu_Audit_2 = Ws_Plan_J2.Range("D7")
 
Set Form_Lieu_Audit_3 = Ws_Plan_J3.Range("D7")
 
Set Form_Lieu_Audit_4 = Ws_Plan_J4.Range("D7")
 
Set Form_Evolutions = Ws_Cloture.Range("D13") 'Propriete de Qualitia Certification
Set Form_Points_Forts = Ws_Cloture.Range("D15")
Set Form_NC_Contestees = Ws_Cloture.Range("D23")
 
Set Form_Info_OPAC = Ws_Presence.Range("B19")
Set Form_Presta_OF = Ws_Presence.Range("B23")
Set Form_Presta_CBC = Ws_Presence.Range("B25")
Set Form_Presta_VAE = Ws_Presence.Range("B27")
Set Form_Presta_CFA = Ws_Presence.Range("B29")
Set Form_Justification = Ws_Presence.Range("B39")
 
 
Set Audit_I = Worksheets(1).Cells(2, 2)
Set Audit_S = Worksheets(1).Cells(3, 2)
Set Audit_R = Worksheets(1).Cells(4, 2)
Set Audit_C = Worksheets(1).Cells(5, 2)
Set Audit_E = Worksheets(1).Cells(6, 2)
Set P_Audit = Worksheets(1).Cells(7, 2)
 
Set Fct_ctrl = Worksheets(1).Cells(2, 14)
Set Site_ech = Worksheets(1).Cells(3, 14)
 
Set Type_Audit = Ws_Plan.Range("D13")
Set Modalite_Audit = Ws_Plan.Range("D15")
Set Multi_Site = Ws_Plan.Range("D40")
Set Caract_Site = Ws_Plan.Range("D42")
Set Duree_Audit = Ws_Plan.Range("L19")
Set xRg = ActiveSheet.Cells
 
Set Check_CNEFOP = Ws_Plan.Shapes("Check_CNEFOP_XL").ControlFormat
 
Set Check_NE_OF = Ws_Plan.Shapes("Check_NE_OF_XL").ControlFormat
Set Check_NE_CBC = Ws_Plan.Shapes("Check_NE_CBC_XL").ControlFormat
Set Check_NE_VAE = Ws_Plan.Shapes("Check_NE_VAE_XL").ControlFormat 'Propriete de Qualitia Certification
Set Check_NE_CFA = Ws_Plan.Shapes("Check_NE_CFA_XL").ControlFormat
 
Set Check_OF = Ws_Plan.Shapes("Check_OF_XL").ControlFormat
Set Check_CBC = Ws_Plan.Shapes("Check_CBC_XL").ControlFormat
Set Check_VAE = Ws_Plan.Shapes("Check_VAE_XL").ControlFormat
Set Check_CFA = Ws_Plan.Shapes("Check_CFA_XL").ControlFormat
'------------------------------------------------------IDENTIFICATION DES LIGNES
'-----INDICATEUR 1 ---------------------------------
Set IND_01_OF = Ws_Rapport.Rows("15:18").EntireRow
Set IND_01_CBC = Ws_Rapport.Rows("21:24").EntireRow
Set IND_01_VAE = Ws_Rapport.Rows("27:30").EntireRow
Set IND_01_CFA = Ws_Rapport.Rows("33:36").EntireRow
    '-----INDICATEUR 2 ---------------------------------
    Set IND_02_OF = Ws_Rapport.Rows("39:42").EntireRow
    Set IND_02_CBC = Ws_Rapport.Rows("43:46").EntireRow
    Set IND_02_VAE = Ws_Rapport.Rows("47:50").EntireRow
    Set IND_02_CFA = Ws_Rapport.Rows("51:54").EntireRow
'-----INDICATEUR 3 ---------------------------------
Set IND_03_OF = Ws_Rapport.Rows("56:59").EntireRow
Set IND_03_CBC = Ws_Rapport.Rows("60:63").EntireRow
Set IND_03_VAE = Ws_Rapport.Rows("64:67").EntireRow
Set IND_03_CFA = Ws_Rapport.Rows("68:71").EntireRow
    '-----INDICATEUR 4 ---------------------------------'Propriete de Qualitia Certification
    Set IND_04_OF = Ws_Rapport.Rows("74:77").EntireRow
    Set IND_04_CBC = Ws_Rapport.Rows("78:81").EntireRow
    Set IND_04_VAE = Ws_Rapport.Rows("82:85").EntireRow
    Set IND_04_CFA = Ws_Rapport.Rows("86:89").EntireRow
'-----INDICATEUR 5 ---------------------------------
Set IND_05_OF = Ws_Rapport.Rows("90:93").EntireRow
Set IND_05_CBC = Ws_Rapport.Rows("94:97").EntireRow
Set IND_05_VAE = Ws_Rapport.Rows("98:101").EntireRow
Set IND_05_CFA = Ws_Rapport.Rows("102:105").EntireRow
    '-----INDICATEUR 6 ---------------------------------
    Set IND_06_OF = Ws_Rapport.Rows("106:109").EntireRow
    Set IND_06_CBC = Ws_Rapport.Rows("110:113").EntireRow
    Set IND_06_VAE = Ws_Rapport.Rows("114:117").EntireRow
    Set IND_06_CFA = Ws_Rapport.Rows("118:121").EntireRow
'-----INDICATEUR 7 ---------------------------------
Set IND_07_OF = Ws_Rapport.Rows("123:126").EntireRow
Set IND_07_CBC = Ws_Rapport.Rows("127:130").EntireRow
Set IND_07_VAE = Ws_Rapport.Rows("131:134").EntireRow
Set IND_07_CFA = Ws_Rapport.Rows("135:138").EntireRow 'Propriete de Qualitia Certification
    '-----INDICATEUR 8 ---------------------------------
    Set IND_08_OF = Ws_Rapport.Rows("139:142").EntireRow
    Set IND_08_CBC = Ws_Rapport.Rows("143:146").EntireRow
    Set IND_08_VAE = Ws_Rapport.Rows("147:150").EntireRow
    Set IND_08_CFA = Ws_Rapport.Rows("151:154").EntireRow
'-----INDICATEUR 9 ---------------------------------
Set IND_09_OF = Ws_Rapport.Rows("157:160").EntireRow
Set IND_09_CBC = Ws_Rapport.Rows("161:164").EntireRow
Set IND_09_VAE = Ws_Rapport.Rows("165:168").EntireRow
Set IND_09_CFA = Ws_Rapport.Rows("169:172").EntireRow
    '-----INDICATEUR 10 ---------------------------------
    Set IND_10_OF = Ws_Rapport.Rows("173:176").EntireRow
    Set IND_10_CBC = Ws_Rapport.Rows("177:180").EntireRow
    Set IND_10_VAE = Ws_Rapport.Rows("181:184").EntireRow
    Set IND_10_CFA = Ws_Rapport.Rows("185:188").EntireRow
'-----INDICATEUR 11 ---------------------------------
Set IND_11_OF = Ws_Rapport.Rows("189:192").EntireRow
Set IND_11_CBC = Ws_Rapport.Rows("193:196").EntireRow
Set IND_11_VAE = Ws_Rapport.Rows("197:200").EntireRow 'Propriete de Qualitia Certification
Set IND_11_CFA = Ws_Rapport.Rows("201:204").EntireRow
    '-----INDICATEUR 12 ---------------------------------
    Set IND_12_OF = Ws_Rapport.Rows("205:208").EntireRow
    Set IND_12_CBC = Ws_Rapport.Rows("209:212").EntireRow
    Set IND_12_VAE = Ws_Rapport.Rows("213:216").EntireRow
    Set IND_12_CFA = Ws_Rapport.Rows("217:220").EntireRow
'-----INDICATEUR 13 ---------------------------------
Set IND_13_OF = Ws_Rapport.Rows("222:225").EntireRow
Set IND_13_CBC = Ws_Rapport.Rows("226:229").EntireRow
Set IND_13_VAE = Ws_Rapport.Rows("230:233").EntireRow
Set IND_13_CFA = Ws_Rapport.Rows("234:237").EntireRow
    '-----INDICATEUR 14 ---------------------------------
    Set IND_14_OF = Ws_Rapport.Rows("238:241").EntireRow
    Set IND_14_CBC = Ws_Rapport.Rows("242:245").EntireRow
    Set IND_14_VAE = Ws_Rapport.Rows("246:249").EntireRow
    Set IND_14_CFA = Ws_Rapport.Rows("250:253").EntireRow
'-----INDICATEUR 15 ---------------------------------
Set IND_15_OF = Ws_Rapport.Rows("254:257").EntireRow
Set IND_15_CBC = Ws_Rapport.Rows("258:261").EntireRow
Set IND_15_VAE = Ws_Rapport.Rows("262:265").EntireRow
Set IND_15_CFA = Ws_Rapport.Rows("266:269").EntireRow
    '-----INDICATEUR 16 ---------------------------------
    Set IND_16_OF = Ws_Rapport.Rows("270:273").EntireRow
    Set IND_16_CBC = Ws_Rapport.Rows("274:277").EntireRow 'Propriete de Qualitia Certification
    Set IND_16_VAE = Ws_Rapport.Rows("278:281").EntireRow
    Set IND_16_CFA = Ws_Rapport.Rows("282:285").EntireRow
'-----INDICATEUR 17 ---------------------------------
Set IND_17_OF = Ws_Rapport.Rows("288:291").EntireRow
Set IND_17_CBC = Ws_Rapport.Rows("292:295").EntireRow
Set IND_17_VAE = Ws_Rapport.Rows("296:299").EntireRow
Set IND_17_CFA = Ws_Rapport.Rows("300:303").EntireRow
    '-----INDICATEUR 18 ---------------------------------
    Set IND_18_OF = Ws_Rapport.Rows("304:307").EntireRow
    Set IND_18_CBC = Ws_Rapport.Rows("308:311").EntireRow
    Set IND_18_VAE = Ws_Rapport.Rows("312:315").EntireRow
    Set IND_18_CFA = Ws_Rapport.Rows("316:319").EntireRow
'-----INDICATEUR 19 ---------------------------------
Set IND_19_OF = Ws_Rapport.Rows("320:323").EntireRow
Set IND_19_CBC = Ws_Rapport.Rows("324:327").EntireRow
Set IND_19_VAE = Ws_Rapport.Rows("328:331").EntireRow
Set IND_19_CFA = Ws_Rapport.Rows("332:335").EntireRow
    '-----INDICATEUR 20 ---------------------------------
    Set IND_20_OF = Ws_Rapport.Rows("337:340").EntireRow
    Set IND_20_CBC = Ws_Rapport.Rows("341:344").EntireRow
    Set IND_20_VAE = Ws_Rapport.Rows("345:348").EntireRow
    Set IND_20_CFA = Ws_Rapport.Rows("349:352").EntireRow
'-----INDICATEUR 21 ---------------------------------
Set IND_21_OF = Ws_Rapport.Rows("355:358").EntireRow
Set IND_21_CBC = Ws_Rapport.Rows("359:362").EntireRow
Set IND_21_VAE = Ws_Rapport.Rows("363:366").EntireRow
Set IND_21_CFA = Ws_Rapport.Rows("367:370").EntireRow 'Propriete de Qualitia Certification
    '-----INDICATEUR 22 ---------------------------------
    Set IND_22_OF = Ws_Rapport.Rows("371:374").EntireRow
    Set IND_22_CBC = Ws_Rapport.Rows("375:378").EntireRow
    Set IND_22_VAE = Ws_Rapport.Rows("379:382").EntireRow
    Set IND_22_CFA = Ws_Rapport.Rows("383:386").EntireRow
'-----INDICATEUR 23----------------------------------
Set IND_23_OF = Ws_Rapport.Rows("389:392").EntireRow
Set IND_23_CBC = Ws_Rapport.Rows("393:396").EntireRow
Set IND_23_VAE = Ws_Rapport.Rows("397:400").EntireRow
Set IND_23_CFA = Ws_Rapport.Rows("401:404").EntireRow
    '-----INDICATEUR 24 ---------------------------------
    Set IND_24_OF = Ws_Rapport.Rows("405:408").EntireRow
    Set IND_24_CBC = Ws_Rapport.Rows("409:412").EntireRow
    Set IND_24_VAE = Ws_Rapport.Rows("413:416").EntireRow
    Set IND_24_CFA = Ws_Rapport.Rows("417:420").EntireRow
'-----INDICATEUR 25 ---------------------------------
Set IND_25_OF = Ws_Rapport.Rows("421:424").EntireRow
Set IND_25_CBC = Ws_Rapport.Rows("425:428").EntireRow
Set IND_25_VAE = Ws_Rapport.Rows("429:432").EntireRow
Set IND_25_CFA = Ws_Rapport.Rows("433:436").EntireRow
    '-----INDICATEUR 26 ---------------------------------'Propriete de Qualitia Certification
    Set IND_26_OF = Ws_Rapport.Rows("437:440").EntireRow
    Set IND_26_CBC = Ws_Rapport.Rows("441:444").EntireRow
    Set IND_26_VAE = Ws_Rapport.Rows("445:448").EntireRow
    Set IND_26_CFA = Ws_Rapport.Rows("449:452").EntireRow
'-----INDICATEUR 27 ---------------------------------
Set IND_27_OF = Ws_Rapport.Rows("453:456").EntireRow
Set IND_27_CBC = Ws_Rapport.Rows("457:460").EntireRow
Set IND_27_VAE = Ws_Rapport.Rows("461:464").EntireRow
Set IND_27_CFA = Ws_Rapport.Rows("465:468").EntireRow
    '-----INDICATEUR 28 ---------------------------------
    Set IND_28_OF = Ws_Rapport.Rows("470:473").EntireRow
    Set IND_28_CBC = Ws_Rapport.Rows("474:477").EntireRow
    Set IND_28_VAE = Ws_Rapport.Rows("478:481").EntireRow
    Set IND_28_CFA = Ws_Rapport.Rows("482:485").EntireRow
'-----INDICATEUR 29 ---------------------------------
Set IND_29_OF = Ws_Rapport.Rows("486:489").EntireRow
Set IND_29_CBC = Ws_Rapport.Rows("490:493").EntireRow
Set IND_29_VAE = Ws_Rapport.Rows("494:497").EntireRow
Set IND_29_CFA = Ws_Rapport.Rows("498:501").EntireRow
    '-----INDICATEUR 30 ---------------------------------
    Set IND_30_OF = Ws_Rapport.Rows("504:507").EntireRow
    Set IND_30_CBC = Ws_Rapport.Rows("508:511").EntireRow
    Set IND_30_VAE = Ws_Rapport.Rows("512:515").EntireRow
    Set IND_30_CFA = Ws_Rapport.Rows("516:519").EntireRow 'Propriete de Qualitia Certification
'-----INDICATEUR 31 ---------------------------------
Set IND_31_OF = Ws_Rapport.Rows("520:523").EntireRow
Set IND_31_CBC = Ws_Rapport.Rows("524:527").EntireRow
Set IND_31_VAE = Ws_Rapport.Rows("528:531").EntireRow
Set IND_31_CFA = Ws_Rapport.Rows("532:535").EntireRow
    '-----INDICATEUR 32 ---------------------------------
    Set IND_32_OF = Ws_Rapport.Rows("536:539").EntireRow
    Set IND_32_CBC = Ws_Rapport.Rows("540:543").EntireRow
    Set IND_32_VAE = Ws_Rapport.Rows("544:547").EntireRow
    Set IND_32_CFA = Ws_Rapport.Rows("548:551").EntireRow
'-----EXIGENCE 1 ------------------------------------
Set IND_E1 = Ws_Rapport.Rows("554:555").EntireRow
    '-----EXIGENCE 2 ------------------------------------
    Set IND_E2 = Ws_Rapport.Rows("556:557").EntireRow
'-----EXIGENCE 3 ------------------------------------
Set IND_E3 = Ws_Rapport.Rows("559:562").EntireRow
    '-----EXIGENCE 4 ------------------------------------
    Set IND_E4 = Ws_Rapport.Rows("563:566").EntireRow
 
'----------------------------------------------------- LIGNES SPECIFIQUES
Set Lg_Caract_Site = Ws_Plan.Rows("41:42").EntireRow
Set Lg_Multi_Site = Ws_Rapport.Rows("558:558").EntireRow
Set Tic_utilise = Ws_Plan.Rows("37:38").EntireRow
Set Moyens_utilises = Ws_Conclusion.Rows("26:31").EntireRow
Set Presta_OF = Ws_Presence.Rows("22:23").EntireRow 'Propriete de Qualitia Certification
Set Presta_CBC = Ws_Presence.Rows("24:25").EntireRow
Set Presta_VAE = Ws_Presence.Rows("26:27").EntireRow
Set Presta_CFA = Ws_Presence.Rows("28:29").EntireRow
'Set Plan_Fct_Ctrl = Ws_Plan.Rows("64").EntireRow
Set PlanJ2_Fct_Ctrl = Ws_Plan_J2.Rows("22").EntireRow
Set PlanJ3_Fct_Ctrl = Ws_Plan_J3.Rows("22").EntireRow
Set PlanJ4_Fct_Ctrl = Ws_Plan_J4.Rows("22").EntireRow 'Propriete de Qualitia Certification
 
'------------------------------------------------------IDENTIFICATION DES COLONNES
Set Col_GEN = Ws_Rapport.Columns("H:H").EntireColumn
Set Col_NE = Ws_Rapport.Columns("I:I").EntireColumn
Set Col_CNEFOP = Ws_Rapport.Columns("J:J").EntireColumn
Set Col_SURV = Ws_Rapport.Columns("H:J").EntireColumn
'Propriete de Qualitia Certification
 
Set verif_fct_ctrl = Worksheets(1).Cells(22, 4)
 
    For I = 53 To 100
        If Ws_Plan.Range("J" & I) = verif_fct_ctrl.Value Then
            Set Plan_Fct_Ctrl = Ws_Plan.Rows(I).EntireRow 'Ligne verification de la fonction centrale variable
        End If
    Next
 
    For J = 53 To 100
        If Ws_PlanJ2.Range("J" & J) = verif_fct_ctrl.Value Then
            Set PlanJ2_Fct_Ctrl = Ws_Plan.Rows(J).EntireRow 'Ligne verification de la fonction centrale variable
        End If
    Next
 
    For K = 53 To 100
        If Ws_PlanJ3.Range("J" & K) = verif_fct_ctrl.Value Then
            Set PlanJ3_Fct_Ctrl = Ws_Plan.Rows(K).EntireRow 'Ligne verification de la fonction centrale variable
        End If
    Next
 
    For L = 53 To 100
        If Ws_PlanJ4.Range("J" & L) = verif_fct_ctrl.Value Then
            Set PlanJ4_Fct_Ctrl = Ws_Plan.Rows(L).EntireRow 'Ligne verification de la fonction centrale variable
        End If
    Next
'Propriete de Qualitia Certification
End Sub

Sheet

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
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
 
Private Sub Worksheet_Change(ByVal Target As Range)
'Propriete de Qualitia Certification
 
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
 
Call Initialisation
 
'-----------------------------------------Societe Auditee
    Set KeyCells = Range("D7:H7")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Societe_Auditee.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D7:H7").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext 'Propriete de Qualitia Certification
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D7").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Correspondant
    Set KeyCells = Range("D9:H9")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Correspondant.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D9:H9").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D9").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Responsable d'audit
    Set KeyCells = Range("D11:H11")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Responsable_Audit.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D11:H11").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False 'Propriete de Qualitia Certification
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D11").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Type d'audit
    Set KeyCells = Range("D13:H13")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Type_Audit.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D13:H13").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext 'Propriete de Qualitia Certification
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D13").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Modalites d'audit
    Set KeyCells = Range("D15:H15")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Modalites.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D15:H15").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0 'Propriete de Qualitia Certification
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D15").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Numero d'affaire
    Set KeyCells = Range("L7:M7")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Num_Affaire.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("L7:M7").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("L7").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Mail Audite
    Set KeyCells = Range("K9:M9")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Mail_Audite.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("K9:M9").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("K9").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Tel Audite
    Set KeyCells = Range("K11:M11")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Tel_Audite.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("K11:M11").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("K11").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Mail Auditeur
    Set KeyCells = Range("K13:M13")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Mail_Auditeur.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("K13:M13").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("K13").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Tel Auditeur
    Set KeyCells = Range("K15:M15")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Tel_Auditeur.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("K15:M15").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("K15").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Observateur
    Set KeyCells = Range("K17:M17")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Observateur.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("K17:M17").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("K17").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Sige Social
    Set KeyCells = Range("D36:M36")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Adresse_Siege.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D36:M36").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Ws_Plan.Range("D36").Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
'-----------------------------------------Lieu d'audit J1
    Set KeyCells = Range("D49:M49")
 
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
 
Select Case Form_Lieu_Audit_1.Value
Case Is <> ""
Ws_Plan.Unprotect
    Ws_Plan.Range("D49:M49").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Rows.AutoFit
    Form_Lieu_Audit_1.Select
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Case Else
End Select
 
End If
 
 
 
 
 
'-------------------------------------------------------------------------------------------------------------------------
'AFFICHER / CACHER LES LIGNES DE CARACTERISTIQUES DE SITE SI C'EST MONO SITE
 
Select Case Multi_Site.Value
 
Case "Multi Sites"
Ws_Plan.Unprotect
Ws_Plan_J2.Unprotect
Ws_Plan_J3.Unprotect
Ws_Plan_J4.Unprotect
'    Plan_Fct_Ctrl.Hidden = False
'    PlanJ2_Fct_Ctrl.Hidden = False
'    PlanJ3_Fct_Ctrl.Hidden = False
'    PlanJ4_Fct_Ctrl.Hidden = False
    Lg_Caract_Site.Hidden = False 'Affiche si Multi Sites
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Ws_Plan_J2.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Ws_Plan_J3.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Ws_Plan_J4.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
 
Case Else
Ws_Plan.Unprotect
Ws_Plan_J2.Unprotect
Ws_Plan_J3.Unprotect
Ws_Plan_J4.Unprotect
'    Plan_Fct_Ctrl.Hidden = True
'    PlanJ2_Fct_Ctrl.Hidden = True
'    PlanJ3_Fct_Ctrl.Hidden = True
'    PlanJ4_Fct_Ctrl.Hidden = True
    Lg_Caract_Site.Hidden = True 'Cache si Multi Sites
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Ws_Plan_J2.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Ws_Plan_J3.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
Ws_Plan_J4.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
 
End Select
 
 
''-------------------------------------------------------------------------------------------------------------------------
''-------------------------------------------------------------------------------------------------------------------------
''AFFICHER / CACHER LES LIGNES DE MODALITES DE SITE SI C'EST A DISTANCE
'If Modalite_Audit.Value = "Audit realise sur site" Then
 
Select Case Modalite_Audit.Value
 
Case Worksheets(1).Cells(14, 4).Value 'Audit realise sur site
Ws_Plan.Unprotect
    Tic_utilise.Hidden = True 'Cache si sur site
    Moyens_utilises.Hidden = True
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
 
Case Worksheets(1).Cells(15, 4).Value 'Audit realise a distance
Ws_Plan.Unprotect
    Tic_utilise.Hidden = False 'Affiche si pas sur site
    Moyens_utilises.Hidden = False
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
 
Case Else
Ws_Plan.Unprotect
    Tic_utilise.Hidden = True 'Cache si pas renseigne
    Moyens_utilises.Hidden = True
Ws_Plan.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
 
End Select
 
 
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
 
'Proprietede Qualitia Certification
 
End Sub

**deedolith** · 28/05/2024, 11h27

Salut,

OMFG !!!

Une fonction de plus de 300 lignes, et une autre de plus de 450 lignes !!

Je pense qu'il y a un gros travail de factorisation à faire,
et jette un coup d'œil à ces articles:
https://en.wikipedia.org/wiki/Single...lity_principle
https://fr.wikipedia.org/wiki/Loi_de_D%C3%A9m%C3%A9ter

Concernant les performances:
Ton code passe son temps à sélectionner tout et n'importe quoi, ce qui est particulièrement lent. Pas étonnant qu'elles soient minables.

Bref:
Use et abuse des références, elles sont faites pour ca.
Ecrit des fonctions courtes.
Tires avantage des boucles.

formatage automatique des cellules

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager