Format nombre se change en [$-40C]j*

**leloup84** · 20/03/2020, 11h42

Bonjour,
J'ai un fichier Excel avec des macros.
Le fichier a des cellules qui sont en format nombre et il fonctionne normalement, d'ailleurs les macros qui font de la mise en forme fonctionne.
Pour autant par moment quand on ouvre le ficher on se retrouve avec toutes les cellules en format nombre désormais en format "[$-40C]jjjj" qui met dans mes cellules du coup lundi, mardi, mercredi...

Quelques informations supplémentaires :
- Nous sommes 3 à travailler sur ce fichier à tour de rôle. J'enlève le fait que quelqu'un le fasse volontairement, il y a de l'Excel 2013 et 2016
- J'ai ouvert sur les 3 ordinateurs un Excel vierge pour voir si dans les format, notamment personnalisé ce format justement était présent et accessible. Ca n'est pas le cas.

**Patrice740** · 20/03/2020, 11h46

Bonjour,

Envoyé par leloup84

J'ai un fichier Excel avec des macros.

Ma boule de cristal est confinée, si tu ne publies pas les macros, je n'arriverais pas à les lire.

**leloup84** · 20/03/2020, 11h52

Je ne l'ai pas publié car pour moi la macro tourne et fonctionne correctement, les données sont bonne et au bon format quand on enregistre.
Mais je peux vous donner un exemple du fichier en privé, si vous le souhaitez.

**Philippe Tulliez** · 20/03/2020, 12h01

Bonjour,

Je ne l'ai pas publié car pour moi la macro tourne et fonctionne correctement, les données sont bonne et au bon format quand on enregistre.

Si pour toi, la macro tourne et fonctionne on se demande pourquoi tu demandes de l'aide.

J'avoue que cela devient de plus en plus pénible

**leloup84** · 20/03/2020, 12h06

Le ton est un peu bizarre, donc je précise :
J'ai mis dans le forum Excel car pour savoir si c'était un bug lié à Excel que quelqu'un avait déjà rencontré à l'ouverture de ses fichiers un changement de format.

J'ai indiqué qu'il y avait une macro pour que toutes les informations soit données pour aider au mieux ceux qui allait me répondre, comme la notion de version 2013/2016 et qu'on travaille à 3 dessus.

Après si quelqu'un penche sur la macro, d'une je peux déplacer le sujet ou transmettre la macro.
Je pense qu'il y avait un moyen plus sympa d'expliquer votre analyse

Après je peux le transmettre en privé pour ceux qui veulent car la macro est assez imposante et confidentielle s'agissant du macro professionnelle.

**Menhir** · 20/03/2020, 12h07

Envoyé par leloup84

pour moi la macro tourne et fonctionne correctement

Si d’emblée tu exclus l'hypothèse que ça ait été fait par une macro ou une personne, il ne reste plus qu'une seule hypothèse : l'envoutement.
Mais dans ce cas, il ne faut pas faire appel à des développeurs mais à un marabout.

Perso, je verrais bien le coupable sous les traits d'une macro événementielle comme Open ou BeforeClose.
Mais puisque tu dis que c'est impossible, inutile de chercher dans cette direction...

Mais je peux vous donner un exemple du fichier en privé, si vous le souhaitez.

Déjà, bon nombres de participants actifs à ce forum n'ouvrent pas les fichiers joints, entre autre pour les raisons expliquées ici :
https://www.developpez.net/forums/d8...s-discussions/
D'autant plus s'ils peuvent contenir des macros.

Et d'autant plus s'il s'agit de fichiers douteux ou... envoutés.

J'ai mis dans le forum Excel car pour savoir si c'était un bug lié à Excel

J'avais oublié l'hypothèse du fameux "bug Excel".
Pour info, ça fait environ 30 ans que j'utilise Excel et, au cours de cette période, je n'ai décelé qu'une seule fois un véritable bug dans les multiples versions successives que j'ai eu à utiliser.

Il me semble donc que cette hypothèse est beaucoup moins probable que les deux que tu as écartées.

Mais depuis que j'ai entendu Donald Trum déclarer que le réchauffement climatique n'est pas du à l'activité humaine mais est l'oeuvre de Dieu (hypothèse acceptée par une large part de son électorat), je ne m'étonne plus de rien.

**leloup84** · 20/03/2020, 12h25

Merci de ton retour.
Voici donc le fichier avec les macros si c'est vers ce point que vous penchez.
Menhir j'ai bien noté ta remarque sur le fait que certains ne l'ouvriront pas.
Planning.xlsm

**78chris** · 20/03/2020, 15h11

Bonjour

Vérifier le style des cellules concernées : le format de nombre du style a peut-être été modifié sur le PC

Le format incriminé fait partie des formats Excel

**leloup84** · 20/03/2020, 15h46

Oui quand ce genre d'anomalie apparaît si je fais un clic droit format sur la cellule je n'ai plus "nombre" mais "[$-40C]jjjj"

**Menhir** · 20/03/2020, 16h14

Attention aux termes.
78Chris (

) ne parle pas seulement de format de cellule mais de format de Style.
Ce qui, effectivement, peut être plus sournois comme problème.

**leloup84** · 27/03/2020, 14h02

Bonjour,
Cela se trouve où exactement format de style ?
Et ce format pourrait se modifier au travers de la macro ?

**Patrice740** · 27/03/2020, 14h51

Bonjour,

Sur le PC à problème :
Accueil / Style / Styles de cellules / Clic droit sur Normal / Modifier / Vérifier que Nombre = Standard, sinon Format /onglet Nombre = Standard

**Menhir** · 27/03/2020, 15h08

Envoyé par leloup84

Et ce format pourrait se modifier au travers de la macro ?

Comment pourrions-nous le savoir sans connaitre le code de la macro ?
Cela dit, il est étonnant que tu évoques la macro puisque, dans ta réponses #3, tu as certifié que le problème ne pouvait pas venir de là...

**leloup84** · 27/03/2020, 15h46

J'ai mis le lien de mon fichier un peu plus qui permet d'accéder au macro.
Certifié est un peu fort, mais je suis ouvert à toute possibilité, c'est qu'au départ je pensais que cela venait de Excel plus que de la macro.

**leloup84** · 27/03/2020, 15h48

Le format de style a l'air correct :

Nom : Capture.JPG
Affichages : 368
Taille : 24,5 Ko

**Menhir** · 27/03/2020, 16h16

Envoyé par leloup84

J'ai mis le lien de mon fichier un peu plus qui permet d'accéder au macro.

Re : https://www.developpez.net/forums/d8...s-discussions/

**Patrice740** · 27/03/2020, 16h34

Le style Normal est ... normal !

Envoyé par leloup84

J'ai mis le lien de mon fichier un peu plus qui permet d'accéder au macro.

Il serait plus judicieux de publier les macros.

**leloup84** · 27/03/2020, 17h54

Le souci c'est que ma macro concerne 4 module est son assez longue.
Vous préférez que je publie que de télécharger mon fichier ?

**leloup84** · 31/03/2020, 15h13

Bonjour,

J'ai bien pris en compte que vous ne préférez pas ouvrir de fichier et qu'il vaut mieux copier les données ici.
Comme je vous l'avais dit ma macro est assez longue. Ci-dessous mon ThisWorkBook et les 5 modules :

ThisWorkBook :

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
Private Sub Workbook_Open()
Dim Planning As Worksheet
Dim BDD As Worksheet
Dim Actualiser As Worksheet
Dim JT As Worksheet
Dim SynthèseORDO As Worksheet
 
Set Planning = Worksheets("Planning")
Set BDD = Worksheets("BDD")
Set Actualiser = Worksheets("Actualiser le planning")
Set JT = Worksheets("Liste jour travaillé")
Set SynthèseORDO = Worksheets("Synthèse")
 
    Planning.Visible = 1
    BDD.Visible = 1 'xlSheetVeryHidden
    Actualiser.Visible = 1
    JT.Visible = 1
    SynthèseORDO.Visible = 1
 
 
    Planning.Unprotect
    BDD.Unprotect 'Protect
    Actualiser.Unprotect
    JT.Unprotect
    SynthèseORDO.Unprotect
 
If JT.Range("U2").Value <> Format(Now(), "dd.mm.yy") Then
    Call Bouton3_Cliquer 'mettre à jour les déclarations
    Call Actualiser_Planning
    ActiveWorkbook.Save
    Application.Quit
End If
 
End Sub

Module 1:

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
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
Sub MAJ_BDD()
'ordre : 1
Application.DisplayAlerts = False
 
Dim WB_Planning As Workbook
Dim WB_BDDOF As Workbook
Dim WB_BDDCDE As Workbook
Dim WB_BDDFORECAST As Workbook
 
Dim BDD As Worksheet
Dim BDDOF As Worksheet
Dim INFOOF As Worksheet
Dim BDDCDE As Worksheet
Dim Planning As Worksheet
Dim BDDForecast As Worksheet
 
Set WB_Planning = ActiveWorkbook
Set BDD = WB_Planning.Worksheets("BDD")
Set Planning = WB_Planning.Worksheets("Planning")
Dim ligne_BDD As Integer
ligne_BDD = BDD.UsedRange.Rows.Count
 
Workbooks.Open Filename:="Y:\Ordonnancement\PLANNING FERME-PREVI\Dossier travail\BASEOF_new.xls", ReadOnly:=True
Set WB_BDDORDO = Workbooks("BASEOF_new.xls")
 
Set BDDOF = WB_BDDORDO.Worksheets("Sheet1")
Dim ligne_BDDOF As Integer
ligne_BDDOF = BDDOF.UsedRange.Rows.Count
 
 
'efface l'ancienne BDD
    BDD.Unprotect
    BDD.Activate
    BDD.Range(Cells(2, 1), Cells(ligne_BDD, 1)).EntireRow.Delete
 
'copie les données fermes
    ligne_début_LOU_A = 2
    For i = 1 To ligne_BDDOF
        If BDDOF.Cells(i, 23).Value = "LOUB" Then
                ligne_début_LOU_B = BDDOF.Cells(i, 23).Row
                Exit For
        End If
    Next
    For i = 1 To ligne_BDDOF
        If BDDOF.Cells(i, 23).Value = "MILC" Then
                ligne_début_MIL = BDDOF.Cells(i, 23).Row
                Exit For
        End If
    Next
 
    BDDOF.Activate
    If Planning.Range("v1").Value = "LOUDEAC A" Then
        BDDOF.Range(Cells(2, 1), Cells(ligne_début_LOU_B - 1, 22)).Copy
        BDD.Range("A2").PasteSpecial xlPasteValues
    Else
        If Planning.Range("v1").Value = "LOUDEAC B" Then
            BDDOF.Range(Cells(ligne_début_LOU_B, 1), Cells(ligne_début_MIL - 1, 22)).Copy
            BDD.Range("A2").PasteSpecial xlPasteValues
        Else
            If Planning.Range("v1").Value = "LA CAVALERIE" Then
                BDDOF.Range(Cells(ligne_début_MIL, 1), Cells(ligne_BDDOF, 22)).Copy
                BDD.Range("A2").PasteSpecial xlPasteValues
            End If
        End If
    End If
 
    BDD.Activate
    Workbooks("BASEOF_new.xls").Close False
    ligne_BDD = BDD.UsedRange.Rows.Count
    For i = 1 To ligne_BDD
        BDD.Cells(i, 33).Value = "Y:\Ordonnancement\Lancement\Prélancement Saison " & BDD.Cells(i, 18).Value & "\" & BDD.Cells(i, 11).Value & "\" & BDD.Cells(i, 22).Value & ".xlsm"
    Next
 
'copier les infos liées aux OF préparation...
    Set INFOOF = WB_Planning.Worksheets("Info Série")
    Dim ligne_INFOOF As Integer
    ligne_INFOOF = INFOOF.UsedRange.Rows.Count
    Dim recherche As Variant
    INFOOF.Activate
 
For i = 2 To ligne_BDD
    If BDD.Cells(i, 22).Value = BDD.Cells(i - 1, 22).Value Then
        BDD.Cells(i, 23).PasteSpecial xlPasteValues
    Else
        For y = 2 To ligne_INFOOF
            If BDD.Cells(i, 22).Value = INFOOF.Cells(y, 1).Value Then
                INFOOF.Range(Cells(y, 2), Cells(y, 11)).Copy
                BDD.Cells(i, 23).PasteSpecial xlPasteValues
                Exit For
            End If
        Next
    End If
Next
 
'copie les données prévies
    Workbooks.Open Filename:="Y:\Ordonnancement\PLANNING FERME-PREVI\Dossier travail\BASECDE_new.xls", ReadOnly:=True
    Set WB_BDDCDE = Workbooks("BASECDE_new.xls")
    Set BDDCDE = WB_BDDCDE.Worksheets("Sheet1")
    Dim ligne_BDDCDE As Integer
    Dim nb_LOU_A As Integer
    Dim nb_LOU_B As Integer
    Dim nb_MIL_C As Integer
    ligne_BDDCDE = BDDCDE.UsedRange.Rows.Count
 
 
    nb_LOU_A = 0
    For i = 2 To ligne_BDDCDE
        If BDDCDE.Cells(i, 23).Value = "LOUA" Then
                nb_LOU_A = nb_LOU_A + 1
        End If
    Next
 
    nb_LOU_B = 0
    For i = 2 To ligne_BDDCDE
        If BDDCDE.Cells(i, 23).Value = "LOUB" Then
                nb_LOU_B = nb_LOU_B + 1
        End If
    Next
 
    nb_MIL_C = 0
    For i = 2 To ligne_BDDCDE
        If BDDCDE.Cells(i, 23).Value = "MILC" Then
                nb_MIL_C = nb_MIL_C + 1
        End If
    Next
 
 
    BDDCDE.Activate
    If Planning.Range("v1").Value = "LOUDEAC A" And nb_LOU_A > 0 Then
         For i = 2 To nb_LOU_A + 1
            ligne_BDD = BDD.UsedRange.Rows.Count + 1
            NB_copie = ligne_BDD + BDDCDE.Cells(i, 10).Value - 1
            For y = ligne_BDD To NB_copie
                BDDCDE.Range(Cells(i, 1), Cells(i, 22)).Copy BDD.Cells(y, 1)
                BDD.Cells(y, 10).Value = 1
            Next
        Next
    Else
        If Planning.Range("v1").Value = "LOUDEAC B" And nb_LOU_B <> 0 Then
            For i = nb_LOU_A + 2 To nb_LOU_A + nb_LOU_B + 1
                ligne_BDD = BDD.UsedRange.Rows.Count + 1
                NB_copie = ligne_BDD + BDDCDE.Cells(i, 10).Value - 1
                For y = ligne_BDD To NB_copie
                    BDDCDE.Range(Cells(i, 1), Cells(i, 22)).Copy BDD.Cells(y, 1)
                    BDD.Cells(y, 10).Value = 1
                Next
            Next
        Else
            If Planning.Range("v1").Value = "LA CAVALERIE" And nb_MIL_C <> 0 Then
                For i = nb_LOU_A + nb_LOU_B + 2 To nb_LOU_A + nb_LOU_B + nb_MIL_C + 1
                    ligne_BDD = BDD.UsedRange.Rows.Count + 1
                    NB_copie = ligne_BDD + BDDCDE.Cells(i, 10).Value - 1
                    For y = ligne_BDD To NB_copie
                        BDDCDE.Range(Cells(i, 1), Cells(i, 22)).Copy BDD.Cells(y, 1)
                        BDD.Cells(y, 10).Value = 1
                    Next
                Next
            End If
        End If
    End If
    BDD.Activate
    ligne_BDD = BDD.UsedRange.Rows.Count
    Workbooks("BASECDE_new.xls").Close False
 
 
'copie les données forecast
    Workbooks.Open Filename:="Y:\Commercial\FORECAST\Forecast 2020\Regroupement\FORECAST GENERAL.xlsm", ReadOnly:=True
    Set WB_BDDFORECAST = Workbooks("FORECAST GENERAL.xlsm")
    Set BDDForecast = WB_BDDFORECAST.Worksheets("BDD")
    Dim ligne_BDDForecast As Integer
    ligne_BDDForecast = BDDForecast.UsedRange.Rows.Count
 
    nb_LOU_A = 0
    For i = 2 To ligne_BDDForecast
        If BDDForecast.Cells(i, 23).Value = "LOUA" Then
                nb_LOU_A = nb_LOU_A + 1
        End If
    Next
 
    nb_LOU_B = 0
    For i = 2 To ligne_BDDForecast
        If BDDForecast.Cells(i, 23).Value = "LOUB" Then
                nb_LOU_B = nb_LOU_B + 1
        End If
    Next
 
    nb_MIL_C = 0
    For i = 2 To ligne_BDDForecast
        If BDDForecast.Cells(i, 23).Value = "MILC" Then
                nb_MIL_C = nb_MIL_C + 1
        End If
    Next
 
 
 
    BDDForecast.Activate
    If Planning.Range("v1").Value = "LOUDEAC A" And nb_LOU_A > 0 Then
        For i = 2 To nb_LOU_A + 1
            ligne_BDD = BDD.UsedRange.Rows.Count + 1
            NB_copie = ligne_BDD + BDDForecast.Cells(i, 10).Value - 1
            For y = ligne_BDD To NB_copie
                BDDForecast.Range(Cells(i, 1), Cells(i, 22)).Copy BDD.Cells(y, 1)
                BDD.Cells(y, 10).Value = 1
            Next
        Next
    Else
        If Planning.Range("v1").Value = "LOUDEAC B" And nb_LOU_B <> 0 Then
            For i = nb_LOU_A + 2 To nb_LOU_A + nb_LOU_B + 1
                ligne_BDD = BDD.UsedRange.Rows.Count + 1
                NB_copie = ligne_BDD + BDDForecast.Cells(i, 10).Value - 1
                For y = ligne_BDD To NB_copie
                    BDDForecast.Range(Cells(i, 1), Cells(i, 22)).Copy BDD.Cells(y, 1)
                    BDD.Cells(y, 10).Value = 1
                Next
            Next
        Else
            If Planning.Range("v1").Value = "LA CAVALERIE" And nb_MIL_C <> 0 Then
                For i = nb_LOU_A + nb_LOU_B + 2 To nb_LOU_A + nb_LOU_B + nb_MIL_C + 1
                    ligne_BDD = BDD.UsedRange.Rows.Count + 1
                    NB_copie = ligne_BDD + BDDForecast.Cells(i, 10).Value - 1
                    For y = ligne_BDD To NB_copie
                        BDDForecast.Range(Cells(i, 1), Cells(i, 22)).Copy BDD.Cells(y, 1)
                        BDD.Cells(y, 10).Value = 1
                    Next
                Next
            End If
        End If
    End If
    BDD.Activate
    Workbooks("FORECAST GENERAL.xlsm").Close False
 
For i = 1 To ligne_BDD
    If BDD.Cells(i, 5).Value = "" Then
        BDD.Cells(i, 5).Value = ""
    End If
Next
 
 
Application.DisplayAlerts = True
 
End Sub
 
 
Sub remplir_tpsStd()
'ordre : 2
 
Dim WB_Planning As Workbook
Dim BDD As Worksheet
Dim Tps As Integer
Dim Temps As Worksheet
Dim ligne_BDD As Integer
Dim ligne_Tps As Integer
 
Set WB_Planning = ActiveWorkbook
Set BDD = Worksheets("BDD")
Set Temps = WB_Planning.Worksheets("Temps")
derniereligneBDD = BDD.UsedRange.Rows.Count
 
 
BDD.Activate
'Application.Calculation = xlAutomatic
'ajouter les 2 colonnes "compteur" pour les 1ème => 14ème lignes
BDD.Unprotect
For ligne_BDD = 2 To derniereligneBDD
    BDD.Cells(ligne_BDD, 35).Value = ligne_BDD - 1
    BDD.Cells(ligne_BDD, 40).Value = ligne_BDD - 1
Next
 
BDD.Calculate
 
For ligne_BDD = 2 To derniereligneBDD
    For assemblage = 1 To 1000
        If BDD.Cells(ligne_BDD, 7).Value = Temps.Cells(assemblage, 1).Value Then
            BDD.Cells(ligne_BDD, 36).Value = Temps.Cells(assemblage, 10).Value
            If ligne_BDD = 2 Then
                BDD.Cells(2, 38).Value = BDD.Cells(2, 36).Value
            Else
                BDD.Cells(ligne_BDD, 38).Value = BDD.Cells(ligne_BDD - 1, 38).Value + BDD.Cells(ligne_BDD, 36).Value
            End If
        End If
    Next
Next
 
 
'Application.Calculation = xlManual
End Sub
 
Sub remplir_mois_fab()
'ordre : 3
 
Dim Jour_Travail As Worksheet
Dim BDD As Worksheet
Dim Planning As Worksheet
Dim Planification As Worksheet
Dim BDD_mois As Integer
Dim ligne_BDD As Integer
Dim ligne_cadence As Integer
Dim i As Integer
Dim Nb_MH_P1 As Integer
Dim Temps_MH_P2 As Integer
 
Set Jour_Travail = Worksheets("Liste jour travaillé")
Set BDD = Worksheets("BDD")
Set Synthèse = Worksheets("Synthèse")
Set Planning = Worksheets("Planning")
Set Planification = Worksheets("Planification")
 
BDD.Calculate
Jour_Travail.Calculate
Planification.Calculate
 
' supprimer les éléments renseignés
BDD.Columns("B:C").Delete
BDD.Columns("B").Insert
BDD.Columns("B").Insert
BDD.Range("B1").Value = "Mois de Fab"
BDD.Names.Add _
        Name:="Mois", _
        RefersTo:="=BDD!$B:$B"
BDD.Range("C1").Value = "Jour de Fab"
BDD.Names.Add _
        Name:="Jour", _
        RefersTo:="=BDD!$C:$C"
 
JT_P1 = Planification.Range("S4") + 1
Nb_MH_P1 = Planification.Range("T4").Value
NB_ligne_BDD = BDD.UsedRange.Rows.Count
NB_Ligne_Cadence = Jour_Travail.UsedRange.Rows.Count
 
BDD.Columns("C:C").Select
Selection.NumberFormat = "m/d/yyyy"
 
BDD.Columns("Z:AE").Select
Selection.NumberFormat = "m/d/yyyy"
 
'renseigner la date de fabrication Periode 1 (basse)
For ligne_BDD = 2 To Nb_MH_P1 + 1
    For ligne_cadence = 2 To JT_P1
        'arrêt si dépassement
        If ligne_BDD > NB_ligne_BDD Then
            Exit For
        End If
 
        'renseigne la date de fab
        If BDD.Cells(ligne_BDD, 35) = Jour_Travail.Cells(ligne_cadence, 8) Then
            BDD.Cells(ligne_BDD, 3) = Jour_Travail.Cells(ligne_cadence - 1, 2)
            BDD.Cells(ligne_BDD, 2) = MonthName(Month(BDD.Cells(ligne_BDD, 3)), False)
            Exit For
        Else
            If BDD.Cells(ligne_BDD, 35) > Jour_Travail.Cells(ligne_cadence, 8) _
                And BDD.Cells(ligne_BDD, 35) < Jour_Travail.Cells(ligne_cadence + 1, 8) Then
                BDD.Cells(ligne_BDD, 3) = Jour_Travail.Cells(ligne_cadence, 2)
                BDD.Cells(ligne_BDD, 2) = MonthName(Month(BDD.Cells(ligne_BDD, 3)), False)
                Exit For
            End If
        End If
    Next
Next
 
'renseigner la date de fabrication Periode 2 (haute)
Jour_Travail.Calculate
Planification.Calculate
JT_P2 = Planification.Range("S5")
 
Temps = 0
ligne_cadence = JT_P1
 
For ligne_BDD = Nb_MH_P1 + 2 To NB_ligne_BDD
'si la date est < à la date du jour alors réel du JT
    If Jour_Travail.Cells(ligne_cadence, 2) < Jour_Travail.Range("U4") Then
        For ligne_cadence = JT_P1 To JT_P2 + 1
            'arrêt si dépassement
            If ligne_BDD > NB_ligne_BDD Then
                Exit For
            End If
 
            'renseigne la date de fab
            If BDD.Cells(ligne_BDD, 35) = Jour_Travail.Cells(ligne_cadence, 8) Then
                BDD.Cells(ligne_BDD, 3) = Jour_Travail.Cells(ligne_cadence - 1, 2)
                BDD.Cells(ligne_BDD, 2) = MonthName(Month(BDD.Cells(ligne_BDD, 3)), False)
                Exit For
            Else
                If BDD.Cells(ligne_BDD, 35) > Jour_Travail.Cells(ligne_cadence, 8) _
                    And BDD.Cells(ligne_BDD, 35) < Jour_Travail.Cells(ligne_cadence + 1, 8) Then
                    BDD.Cells(ligne_BDD, 3) = Jour_Travail.Cells(ligne_cadence, 2)
                    BDD.Cells(ligne_BDD, 2) = MonthName(Month(BDD.Cells(ligne_BDD, 3)), False)
                    Exit For
                End If
            End If
        Next
 
    'sinon si la somme des temps est < ou = au temps travaillé lors de la journée alors JT
    Else
        'arrêt si dépassement
        If ligne_BDD > NB_ligne_BDD Then
            Exit For
        End If
 
        If ligne_cadence > JT_P2 Then
            Exit For
        End If
 
        'addition des temps de MH sur une même date
        Temps = Temps + BDD.Cells(ligne_BDD, 36).Value
        Nb_MH = Nb_MH + 1
        BDD.Cells(ligne_BDD, 49).Value = Nb_MH
 
        'pour tenir compte du MH déjà entamé la veille
        If ligne_BDD <> Nb_MH_P1 + 2 Then
            A = A
        Else
            A = Planification.Range("U4") * BDD.Cells(ligne_BDD, 36)
            Nb_MH = Planification.Range("U4")
        End If
 
        'renseigne la date de fab
 
 
                If Temps < Jour_Travail.Cells(ligne_cadence, 15) + A Or Temps = Jour_Travail.Cells(ligne_cadence, 15) + A Then
                    BDD.Cells(ligne_BDD, 3).Value = Jour_Travail.Cells(ligne_cadence, 2)
                    BDD.Cells(ligne_BDD, 2) = MonthName(Month(BDD.Cells(ligne_BDD, 3)), False)
                Else:
 
                    'sinon si le jour JT est non travaillé alors on passe au jour suivant JT et on recommence la ligne BDD
                    If Jour_Travail.Cells(ligne_cadence, 15) = 0 Then
                        ligne_cadence = ligne_cadence + 1
                        ligne_BDD = ligne_BDD - 1
                        A = A
                        Temps = 0
                        Nb_MH = -A / BDD.Cells(ligne_BDD, 36)
 
                    'sinon calul le temps restant pour terminer le MH
                    Else
                        A = BDD.Cells(ligne_BDD, 36) - (Temps - Jour_Travail.Cells(ligne_cadence, 15) - A)
                        Temps = 0
                        Jour_Travail.Cells(ligne_cadence, 7) = Nb_MH - 1 + A / BDD.Cells(ligne_BDD, 36)
                        BDD.Cells(ligne_BDD, 49).Value = A / BDD.Cells(ligne_BDD, 36)
                        Nb_MH = -A / BDD.Cells(ligne_BDD, 36)
                        ligne_cadence = ligne_cadence + 1
                        ligne_BDD = ligne_BDD - 1
                    End If
                End If
            End If
Next
 
Jour_Travail.Calculate
Planification.Calculate
 
'And Jour_Travail.Cells(ligne_cadence, 2) <> BDD.Cells(ligne_BDD - 1, 3) _
'renseigner la date de fabrication Periode 3 (basse)
Nb_MH_P2 = Planification.Range("T5").Value
For ligne_BDD = Nb_MH_P2 + 1 To NB_ligne_BDD + 1
    For ligne_cadence = JT_P2 To NB_Ligne_Cadence
        If BDD.Cells(ligne_BDD, 35) > Jour_Travail.Cells(ligne_cadence, 8) Then
                If BDD.Cells(ligne_BDD, 35) > Jour_Travail.Cells(NB_Ligne_Cadence, 8) Then
                    'MsgBox "Vous prévoyer plus de MH que le takttime et le temps d'ouverture ne le permettent !"
                     Exit Sub
 
 
            End If
        End If
        If ligne_BDD > NB_ligne_BDD Then
            Exit For
        End If
 
        If BDD.Cells(ligne_BDD, 35) = Int(Jour_Travail.Cells(ligne_cadence, 8)) Then
            BDD.Cells(ligne_BDD, 3) = Jour_Travail.Cells(ligne_cadence - 1, 2)
            BDD.Cells(ligne_BDD, 2) = MonthName(Month(BDD.Cells(ligne_BDD, 3)), False)
            Exit For
        Else
            If BDD.Cells(ligne_BDD, 35) > Jour_Travail.Cells(ligne_cadence, 8) _
                And BDD.Cells(ligne_BDD, 35) < Jour_Travail.Cells(ligne_cadence + 1, 8) Then
                BDD.Cells(ligne_BDD, 3) = Jour_Travail.Cells(ligne_cadence, 2)
                BDD.Cells(ligne_BDD, 2) = MonthName(Month(BDD.Cells(ligne_BDD, 3)), False)
                Exit For
            End If
        End If
    Next
Next
 
End Sub
 
 
Sub Date_liv_fab()
'ordre : 4
Dim BDD As Worksheet
Dim ligne_BDD As Integer
Dim i As Integer
 
Set BDD = Worksheets("BDD")
derniereligneBDD = BDD.UsedRange.Rows.Count
 
 
For ligne_BDD = 2 To derniereligneBDD
'relever les incohérence date de fab et date de liv
    If BDD.Cells(ligne_BDD, 16) = "" Xor BDD.Cells(ligne_BDD, 16) = "00:00:00" Xor BDD.Cells(ligne_BDD, 16) - BDD.Cells(ligne_BDD, 3) > 14 Then
        BDD.Cells(ligne_BDD, 34).Value = ""
    Else
        If BDD.Cells(ligne_BDD, 16) - BDD.Cells(ligne_BDD, 3) < 8 Then
            BDD.Cells(ligne_BDD, 34).Value = 255 'rouge
        Else: BDD.Cells(ligne_BDD, 34).Value = 49407 'orange
        End If
    End If
 
'info pour graphiques
    If BDD.Cells(ligne_BDD, 6) = "" Then
        If BDD.Cells(ligne_BDD, 16) > (Date + 84) Then
            BDD.Cells(ligne_BDD, 37) = BDD.Cells(ligne_BDD, 16) - 14
        Else
            BDD.Cells(ligne_BDD, 37) = Date + 77
        End If
    Else: BDD.Cells(ligne_BDD, 37) = BDD.Cells(ligne_BDD, 3)
    End If
 
'mois de livraison
    If BDD.Cells(ligne_BDD, 16) = "" Xor BDD.Cells(ligne_BDD, 16) = "00:00:00" Then
        BDD.Cells(ligne_BDD, 41) = ""
    Else
        BDD.Cells(ligne_BDD, 41) = MonthName(Month(BDD.Cells(ligne_BDD, 37)), False)
    End If
Next
End Sub
 
Sub Ecart_date_liv()
'ordre : 5
Dim BDD As Worksheet
Dim JT As Worksheet
Dim ligne_BDD As Integer
Dim i As Integer
 
Set BDD = Worksheets("BDD")
Set JT = Worksheets("Liste jour travaillé")
 
derniereligneBDD = BDD.UsedRange.Rows.Count
 
'Calculer les écarts de jours entre la livraison client et la date entrée de chaîne
For ligne_BDD = 2 To derniereligneBDD
    If BDD.Cells(ligne_BDD, 16) = "" Or BDD.Cells(ligne_BDD, 16) = "00:00:00" Then
        BDD.Cells(ligne_BDD, 39).Value = ""
    Else
        If BDD.Cells(ligne_BDD, 16) >= BDD.Cells(ligne_BDD, 3) Then
            BDD.Cells(ligne_BDD, 39).Value = BDD.Cells(ligne_BDD, 16) - BDD.Cells(ligne_BDD, 3)
        Else
            BDD.Cells(ligne_BDD, 39).Value = -(BDD.Cells(ligne_BDD, 3) * 1 - BDD.Cells(ligne_BDD, 16) * 1)
        End If
    End If
 
    If (BDD.Cells(ligne_BDD, 1) = "P3" Or BDD.Cells(ligne_BDD, 1) = "P4" Or BDD.Cells(ligne_BDD, 1) = "P2" Or BDD.Cells(ligne_BDD, 1) = "P1") And (BDD.Cells(ligne_BDD, 16) - 14) < (JT.Range("u4").Value + 98) Then
        BDD.Cells(ligne_BDD, 42).Value = 16776960
    End If
 
 
Next
End Sub
 
Sub remplir_planning()
'ordre : 6
 
Dim Planning As Worksheet
Dim BDD As Worksheet
Dim JT As Worksheet
Dim ligne_info As Integer
Dim colonne_info As Integer
Dim ligne_à_compléter As Integer
 
Set Planning = Worksheets("Planning")
Set BDD = Worksheets("BDD")
Set JT = Worksheets("Liste jour travaillé")
 
derniereligneBDD = BDD.UsedRange.Rows.Count
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
Planning.Activate
' supprimer les éléments renseignés
Planning.Range("A4").EntireRow.Delete
Planning.Range(Cells(5, 1), Cells(dernierelignePlanning, 1)).EntireRow.Delete
 
' remplir_planning
dernierelignePlanning = BDD.UsedRange.Rows.Count
For ligne_à_compléter = 4 To dernierelignePlanning
For ligne_info = 2 To derniereligneBDD
 
 
    'si la série est la même que la précédente et que le mois est le même alors
    If BDD.Cells(ligne_info, 11) = BDD.Cells(ligne_info - 1, 11) And BDD.Cells(ligne_info, 22) = BDD.Cells(ligne_info - 1, 22) And BDD.Cells(ligne_info, 2) = BDD.Cells(ligne_info - 1, 2) Then
        ligne_à_compléter = ligne_à_compléter + 1
        dernierelignePlanning = dernierelignePlanning + 1
        Planning.Cells(ligne_à_compléter, 1) = BDD.Cells(ligne_info, 5) 'n° châssis
        Planning.Cells(ligne_à_compléter, 2) = BDD.Cells(ligne_info, 10) 'qté à fab
        Planning.Cells(ligne_à_compléter, 3) = BDD.Cells(ligne_info, 9) 'n° cde
        Planning.Cells(ligne_à_compléter, 4) = BDD.Cells(ligne_info, 13) 'Client
        Planning.Cells(ligne_à_compléter, 5) = BDD.Cells(ligne_info, 15) 'Commercial
        Planning.Cells(ligne_à_compléter, 6) = BDD.Cells(ligne_info, 17) 'sem liv
        Planning.Cells(ligne_à_compléter, 7) = BDD.Cells(ligne_info, 21) 'sem liv origine
        Planning.Cells(ligne_à_compléter, 8) = BDD.Cells(ligne_info, 14) 'Tps std
        Planning.Cells(ligne_à_compléter, 8).Style = "Comma"
        Planning.Cells(ligne_à_compléter, 9) = BDD.Cells(ligne_info, 36) 'Tps cadencement
        Planning.Cells(ligne_à_compléter, 9).Style = "Comma"
        Planning.Cells(ligne_à_compléter, 10) = BDD.Cells(ligne_info, 18) 'Millésime
        Planning.Cells(ligne_à_compléter, 11) = BDD.Cells(ligne_info, 19) 'DF
        Planning.Cells(ligne_à_compléter, 12) = BDD.Cells(ligne_info, 2) 'mois de fab
        Planning.Cells(ligne_à_compléter, 13) = BDD.Cells(ligne_info, 1) 'ferme ou prévi
        Planning.Cells(ligne_à_compléter, Format$(BDD.Cells(ligne_info, 3), "dd") + 13) = Planning.Cells(ligne_à_compléter, 2) 'jour fab
 
            With Planning.Rows(ligne_à_compléter)
                .HorizontalAlignment = xlLeft
                .Font.Bold = False
                .Font.Size = 16
                .Font.Name = "Calibri"
            End With
 
        'problème date de fab et date de liv
        If BDD.Cells(ligne_info, 34) <> "" Then
           Planning.Cells(ligne_à_compléter, 1).Interior.Color = BDD.Cells(ligne_info, 34).Value
        End If
        'si date de fab < 2 jour et manque ARC
        If BDD.Cells(ligne_info, 4) = "X" And BDD.Cells(ligne_info, 3) < (JT.Range("u4").Value + 3) Then
            Planning.Cells(ligne_à_compléter, 4).Interior.Color = 255
        End If
        'si date de fab < 14 semaine jour et P3 ou P4
        If (BDD.Cells(ligne_info, 1) = "P3" Or BDD.Cells(ligne_info, 1) = "P4" Or BDD.Cells(ligne_info, 1) = "P2" Or BDD.Cells(ligne_info, 1) = "P1") And (BDD.Cells(ligne_info, 16) - 14) < (JT.Range("u4").Value + 98) Then
            Planning.Cells(ligne_à_compléter, 4).Interior.Color = BDD.Cells(ligne_info, 42).Value
        End If
 
   'sinon si la série est différente que la ligne précédente ou que le mois est différent
    Else
        'renseigner la nouvelle série
        ligne_à_compléter = ligne_à_compléter + 1
        dernierelignePlanning = dernierelignePlanning + 1
 
        Planning.Cells(ligne_à_compléter, 1) = BDD.Cells(ligne_info, 11) 'n° série
        Planning.Hyperlinks.Add anchor:=Cells(ligne_à_compléter, 1), Address:=BDD.Cells(ligne_info, 33).Value 'lien hypertexte
        Planning.Cells(ligne_à_compléter, 4) = BDD.Cells(ligne_info, 22) 'Désignation série
        Planning.Cells(ligne_à_compléter, 12) = BDD.Cells(ligne_info, 2) 'mois
        Planning.Cells(ligne_à_compléter, 13) = BDD.Cells(ligne_info, 1) 'ferme ou prévi
        Planning.Cells(ligne_à_compléter, 1).Activate
        Planning.Cells(ligne_à_compléter, 46) = BDD.Cells(ligne_info, 23)         'Caissons Sexx
        Planning.Cells(ligne_à_compléter, 47) = BDD.Cells(ligne_info, 24) 'Structure
        Planning.Cells(ligne_à_compléter, 48) = BDD.Cells(ligne_info, 25) 'Panneaux Ch
        Planning.Cells(ligne_à_compléter, 49) = Format$(BDD.Cells(ligne_info, 26), "mm/dd/yyyy") 'Ordre Mh
        Planning.Cells(ligne_à_compléter, 50) = Format$(BDD.Cells(ligne_info, 27), "mm/dd/yyyy") 'Structure+bsm
        Planning.Cells(ligne_à_compléter, 51) = Format$(BDD.Cells(ligne_info, 28), "mm/dd/yyyy") 'Meubles
        Planning.Cells(ligne_à_compléter, 52) = Format$(BDD.Cells(ligne_info, 29), "mm/dd/yyyy") 'Bsm
        Planning.Cells(ligne_à_compléter, 53) = Format$(BDD.Cells(ligne_info, 30), "mm/dd/yyyy") 'Docs préparation
        Planning.Cells(ligne_à_compléter, 54) = Format$(BDD.Cells(ligne_info, 31), "mm/dd/yyyy") 'Docs finition
        Planning.Cells(ligne_à_compléter, 55) = Format$(BDD.Cells(ligne_info, 32), "mm/dd/yyyy") 'Contrôle OF
 
        With Planning.Rows(ligne_à_compléter)
                .HorizontalAlignment = xlCenter
                .Font.Bold = True
                .Font.Size = 20
                .Font.Name = "Calibri"
                .Font.Color = -4165632
            End With
 
        'et renseigner la 1ère valeur de la série
        Planning.Cells(ligne_à_compléter + 1, 1) = BDD.Cells(ligne_info, 5) 'n° châssis
        Planning.Cells(ligne_à_compléter + 1, 2) = BDD.Cells(ligne_info, 10) 'qté à fab
        Planning.Cells(ligne_à_compléter + 1, 3) = BDD.Cells(ligne_info, 9) 'n° cde
        Planning.Cells(ligne_à_compléter + 1, 4) = BDD.Cells(ligne_info, 13) 'Client
        Planning.Cells(ligne_à_compléter + 1, 5) = BDD.Cells(ligne_info, 15) 'Commercial
        Planning.Cells(ligne_à_compléter + 1, 6) = BDD.Cells(ligne_info, 17) 'sem liv
        Planning.Cells(ligne_à_compléter + 1, 7) = BDD.Cells(ligne_info, 21) 'sem liv origine
        Planning.Cells(ligne_à_compléter + 1, 8) = BDD.Cells(ligne_info, 14) 'Tps std
        Planning.Cells(ligne_à_compléter + 1, 8).Style = "Comma"
        Planning.Cells(ligne_à_compléter + 1, 9) = BDD.Cells(ligne_info, 36) 'Tps cadencement
        Planning.Cells(ligne_à_compléter + 1, 9).Style = "Comma"
        Planning.Cells(ligne_à_compléter + 1, 10) = BDD.Cells(ligne_info, 18) 'Millésime
        Planning.Cells(ligne_à_compléter + 1, 11) = BDD.Cells(ligne_info, 19) 'DF
        Planning.Cells(ligne_à_compléter + 1, 12) = BDD.Cells(ligne_info, 2) 'mois de fab
        Planning.Cells(ligne_à_compléter + 1, 13) = BDD.Cells(ligne_info, 1) 'ferme ou prévi
        Planning.Cells(ligne_à_compléter + 1, Format$(BDD.Cells(ligne_info, 3), "dd") + 13) = Planning.Cells(ligne_à_compléter + 1, 2) 'jour fab
 
            With Planning.Rows(ligne_à_compléter + 1)
                .HorizontalAlignment = xlLeft
                .Font.Bold = False
                .Font.Size = 16
                .Font.Name = "Calibri"
            End With
 
                'si problème date de fab et date de liv
        If BDD.Cells(ligne_info, 34) <> "" Then
           Planning.Cells(ligne_à_compléter + 1, 1).Interior.Color = BDD.Cells(ligne_info, 34).Value
        End If
 
                'si date de fab < 2 jour et manque ARC
        If BDD.Cells(ligne_info, 4) = "X" And BDD.Cells(ligne_info, 3) < (JT.Range("u4").Value + 3) Then
            Planning.Cells(ligne_à_compléter + 1, 4).Interior.Color = 255 '.ThemeColor = xlThemeColorAccent5
        End If
                'si date de fab < 14 jour et P3 ou P4
        If (BDD.Cells(ligne_info, 1) = "P3" Or BDD.Cells(ligne_info, 1) = "P4" Or BDD.Cells(ligne_info, 1) = "P2" Or BDD.Cells(ligne_info, 1) = "P1") And (BDD.Cells(ligne_info, 16) - 14) < (JT.Range("u4").Value + 98) Then
            Planning.Cells(ligne_à_compléter + 1, 4).Interior.Color = BDD.Cells(ligne_info, 42).Value
        End If
 
 
        ligne_à_compléter = ligne_à_compléter + 1
    End If
Next
Next
 
End Sub
 
Sub format_planning()
'ordre : 7
Dim Planning As Worksheet
Dim ligne_format As Integer
Dim ligne_info As Integer
Dim mois As Integer
Dim semaine As Integer
Dim année As Integer
Dim colonne As Integer
 
Set Planning = Worksheets("Planning")
 
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
'si changement de mois
 
For ligne_info = 5 To dernierelignePlanning + 55
If Planning.Cells(ligne_info + 1, 13).Value = "" Then
    Exit For
Else
If Planning.Cells(ligne_info + 1, 12) <> Planning.Cells(ligne_info, 12) Then
    '1/ajouter 3 lignes vides dont la 1er servira pour le total par mois
        ligne_info = ligne_info + 1
        Rows(ligne_info).Insert
        Rows(ligne_info).Interior.Pattern = xlNone
 
        ligne_info = ligne_info + 1
        Rows(ligne_info).Insert
 
        ligne_info = ligne_info + 1
        Rows(ligne_info).Insert
 
 
        ligne_info = ligne_info + 1
        Rows(ligne_info).Insert
        Planning.Cells(ligne_info, 14) = UCase(Planning.Cells(ligne_info + 1, 12))
        Planning.Range(Cells(ligne_info, 14), Cells(ligne_info, 44)).Select
                    With Selection
                        .HorizontalAlignment = xlCenter
                        .Merge
                        .Font.Size = 36
                        .Font.Bold = True
                        .Borders.Weight = xlMedium
                    End With
 
    '2/ajouter l mois
        ligne_info = ligne_info + 1
        Rows(ligne_info).Insert
        Planning.Rows(4).Copy
        Rows(ligne_info).PasteSpecial
 
End If
End If
Next
 
End Sub
 
Sub grouper()
'ordre : 8
 
Dim Planning As Worksheet
Dim ligne As Integer
Set Planning = Worksheets("Planning")
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
For ligne = 5 To dernierelignePlanning
    If Planning.Cells(ligne, 1).Font.Bold = False And Cells(ligne, 1).Value <> "" And Cells(ligne, 1).Value <> "Série/chassis" Then
    Planning.Rows(ligne).Group
    End If
Next
 
ActiveSheet.Outline.ShowLevels RowLevels:=1
 
End Sub
 
Sub grouper_cde_clt()
'ordre : 9
 
Dim Planning As Worksheet
Dim ligne As Integer
Set Planning = Worksheets("Planning")
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
For ligne = 5 To dernierelignePlanning
    If Cells(ligne, 3).Value <> "n° BC" And Cells(ligne, 3).Value <> "" And Cells(ligne, 3).Value = Cells(ligne - 1, 3).Value Then
        Planning.Rows(ligne).Group
    End If
Next
ActiveSheet.Outline.ShowLevels RowLevels:=1
End Sub
 
Sub CalculSérie()
'ordre : 10
Dim Planning As Worksheet
Dim lignePlanning As Integer
Dim SommeTotal, Somme1, Somme2, Somme3, Somme4, Somme5, Somme6, Somme7, Somme8, Somme9, Somme10, Somme11, Somme12 As Integer
Dim Somme13, Somme14, Somme15, Somme16, Somme17, Somme18, Somme19, Somme20, Somme21, Somme22, Somme23, Somme24, Somme25 As Integer
Dim Somme26, Somme27, Somme28, Somme29, Somme30, Somme31, SommeTps As Integer
 
Set Planning = Worksheets("planning")
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
For lignePlanning = dernierelignePlanning To 5 Step -1
    If Cells(lignePlanning, 1).Font.Bold = True And Cells(lignePlanning, 1).Value <> "Série/chassis" And Cells(lignePlanning, 1).Value <> "" Then
        Cells(lignePlanning, 2).Value = SommeTotal
        Cells(lignePlanning, 8).Value = SommeTps / SommeTotal
        Cells(lignePlanning, 9).Value = SommeTpsAss / SommeTotal
        Cells(lignePlanning, 14).Value = Somme1
        Cells(lignePlanning, 15).Value = Somme2
        Cells(lignePlanning, 16).Value = Somme3
        Cells(lignePlanning, 17).Value = Somme4
        Cells(lignePlanning, 18).Value = Somme5
        Cells(lignePlanning, 19).Value = Somme6
        Cells(lignePlanning, 20).Value = Somme7
        Cells(lignePlanning, 21).Value = Somme8
        Cells(lignePlanning, 22).Value = Somme9
        Cells(lignePlanning, 23).Value = Somme10
        Cells(lignePlanning, 24).Value = Somme11
        Cells(lignePlanning, 25).Value = Somme12
        Cells(lignePlanning, 26).Value = Somme13
        Cells(lignePlanning, 27).Value = Somme14
        Cells(lignePlanning, 28).Value = Somme15
        Cells(lignePlanning, 29).Value = Somme16
        Cells(lignePlanning, 30).Value = Somme17
        Cells(lignePlanning, 31).Value = Somme18
        Cells(lignePlanning, 32).Value = Somme19
        Cells(lignePlanning, 33).Value = Somme20
        Cells(lignePlanning, 34).Value = Somme21
        Cells(lignePlanning, 35).Value = Somme22
        Cells(lignePlanning, 36).Value = Somme23
        Cells(lignePlanning, 37).Value = Somme24
        Cells(lignePlanning, 38).Value = Somme25
        Cells(lignePlanning, 39).Value = Somme26
        Cells(lignePlanning, 40).Value = Somme27
        Cells(lignePlanning, 41).Value = Somme28
        Cells(lignePlanning, 42).Value = Somme29
        Cells(lignePlanning, 43).Value = Somme30
        Cells(lignePlanning, 44).Value = Somme31
        SommeTotal = 0
        SommeTps = 0
        SommeTpsAss = 0
        Somme1 = 0
        Somme2 = 0
        Somme3 = 0
        Somme4 = 0
        Somme5 = 0
        Somme6 = 0
        Somme7 = 0
        Somme8 = 0
        Somme9 = 0
        Somme10 = 0
        Somme11 = 0
        Somme12 = 0
        Somme13 = 0
        Somme14 = 0
        Somme15 = 0
        Somme16 = 0
        Somme17 = 0
        Somme18 = 0
        Somme19 = 0
        Somme20 = 0
        Somme21 = 0
        Somme22 = 0
        Somme23 = 0
        Somme24 = 0
        Somme25 = 0
        Somme26 = 0
        Somme27 = 0
        Somme28 = 0
        Somme29 = 0
        Somme30 = 0
        Somme31 = 0
        Planning.Range(Cells(lignePlanning, 14), Cells(lignePlanning, 44)).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        Planning.Cells(lignePlanning, 8).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        Planning.Cells(lignePlanning, 9).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Else
        If Cells(lignePlanning, 1) <> "Série/chassis" And Cells(lignePlanning, 1) <> "" Then
        SommeTotal = SommeTotal + Cells(lignePlanning, 2).Value
        SommeTps = (SommeTps + Cells(lignePlanning, 8).Value)
        SommeTpsAss = (SommeTpsAss + Cells(lignePlanning, 9).Value)
        Somme1 = Somme1 + Cells(lignePlanning, 14).Value
        Somme2 = Somme2 + Cells(lignePlanning, 15).Value
        Somme3 = Somme3 + Cells(lignePlanning, 16).Value
        Somme4 = Somme4 + Cells(lignePlanning, 17).Value
        Somme5 = Somme5 + Cells(lignePlanning, 18).Value
        Somme6 = Somme6 + Cells(lignePlanning, 19).Value
        Somme7 = Somme7 + Cells(lignePlanning, 20).Value
        Somme8 = Somme8 + Cells(lignePlanning, 21).Value
        Somme9 = Somme9 + Cells(lignePlanning, 22).Value
        Somme10 = Somme10 + Cells(lignePlanning, 23).Value
        Somme11 = Somme11 + Cells(lignePlanning, 24).Value
        Somme12 = Somme12 + Cells(lignePlanning, 25).Value
        Somme13 = Somme13 + Cells(lignePlanning, 26).Value
        Somme14 = Somme14 + Cells(lignePlanning, 27).Value
        Somme15 = Somme15 + Cells(lignePlanning, 28).Value
        Somme16 = Somme16 + Cells(lignePlanning, 29).Value
        Somme17 = Somme17 + Cells(lignePlanning, 30).Value
        Somme18 = Somme18 + Cells(lignePlanning, 31).Value
        Somme19 = Somme19 + Cells(lignePlanning, 32).Value
        Somme20 = Somme20 + Cells(lignePlanning, 33).Value
        Somme21 = Somme21 + Cells(lignePlanning, 34).Value
        Somme22 = Somme22 + Cells(lignePlanning, 35).Value
        Somme23 = Somme23 + Cells(lignePlanning, 36).Value
        Somme24 = Somme24 + Cells(lignePlanning, 37).Value
        Somme25 = Somme25 + Cells(lignePlanning, 38).Value
        Somme26 = Somme26 + Cells(lignePlanning, 39).Value
        Somme27 = Somme27 + Cells(lignePlanning, 40).Value
        Somme28 = Somme28 + Cells(lignePlanning, 41).Value
        Somme29 = Somme29 + Cells(lignePlanning, 42).Value
        Somme30 = Somme30 + Cells(lignePlanning, 43).Value
        Somme31 = Somme31 + Cells(lignePlanning, 44).Value
        End If
    End If
Next
End Sub
 
Sub CalculMois()
'ordre : 11
Dim Planning As Worksheet
Dim lignePlanning As Integer
Dim SommeTotal, Somme1, Somme2, Somme3, Somme4, Somme5, Somme6, Somme7, Somme8, Somme9, Somme10, Somme11, Somme12 As Integer
Dim Somme13, Somme14, Somme15, Somme16, Somme17, Somme18, Somme19, Somme20, Somme21, Somme22, Somme23, Somme24, Somme25 As Integer
Dim Somme26, Somme27, Somme28, Somme29, Somme30, Somme31, SommeTps As Integer
 
Set Planning = Worksheets("planning")
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
For lignePlanning = 5 To dernierelignePlanning
    If Cells(lignePlanning - 1, 1).Value <> "" And Cells(lignePlanning, 1).Value = "" Then
        Cells(lignePlanning, 2).Value = SommeTotal
        Cells(lignePlanning, 8).Value = SommeTps / SommeTotal
        Cells(lignePlanning, 9).Value = SommeTpsAss / SommeTotal
        Cells(lignePlanning, 14).Value = Somme1
        Cells(lignePlanning, 15).Value = Somme2
        Cells(lignePlanning, 16).Value = Somme3
        Cells(lignePlanning, 17).Value = Somme4
        Cells(lignePlanning, 18).Value = Somme5
        Cells(lignePlanning, 19).Value = Somme6
        Cells(lignePlanning, 20).Value = Somme7
        Cells(lignePlanning, 21).Value = Somme8
        Cells(lignePlanning, 22).Value = Somme9
        Cells(lignePlanning, 23).Value = Somme10
        Cells(lignePlanning, 24).Value = Somme11
        Cells(lignePlanning, 25).Value = Somme12
        Cells(lignePlanning, 26).Value = Somme13
        Cells(lignePlanning, 27).Value = Somme14
        Cells(lignePlanning, 28).Value = Somme15
        Cells(lignePlanning, 29).Value = Somme16
        Cells(lignePlanning, 30).Value = Somme17
        Cells(lignePlanning, 31).Value = Somme18
        Cells(lignePlanning, 32).Value = Somme19
        Cells(lignePlanning, 33).Value = Somme20
        Cells(lignePlanning, 34).Value = Somme21
        Cells(lignePlanning, 35).Value = Somme22
        Cells(lignePlanning, 36).Value = Somme23
        Cells(lignePlanning, 37).Value = Somme24
        Cells(lignePlanning, 38).Value = Somme25
        Cells(lignePlanning, 39).Value = Somme26
        Cells(lignePlanning, 40).Value = Somme27
        Cells(lignePlanning, 41).Value = Somme28
        Cells(lignePlanning, 42).Value = Somme29
        Cells(lignePlanning, 43).Value = Somme30
        Cells(lignePlanning, 44).Value = Somme31
        SommeTotal = 0
        SommeTps = 0
        SommeTpsAss = 0
        Somme1 = 0
        Somme2 = 0
        Somme3 = 0
        Somme4 = 0
        Somme5 = 0
        Somme6 = 0
        Somme7 = 0
        Somme8 = 0
        Somme9 = 0
        Somme10 = 0
        Somme11 = 0
        Somme12 = 0
        Somme13 = 0
        Somme14 = 0
        Somme15 = 0
        Somme16 = 0
        Somme17 = 0
        Somme18 = 0
        Somme19 = 0
        Somme20 = 0
        Somme21 = 0
        Somme22 = 0
        Somme23 = 0
        Somme24 = 0
        Somme25 = 0
        Somme26 = 0
        Somme27 = 0
        Somme28 = 0
        Somme29 = 0
        Somme30 = 0
        Somme31 = 0
        Planning.Range(Cells(lignePlanning, 14), Cells(lignePlanning, 44)).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        Planning.Cells(lignePlanning, 8).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        Planning.Cells(lignePlanning, 9).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        Planning.Rows(lignePlanning).Font.Bold = True
    Else
        If Cells(lignePlanning, 1) <> "" And Cells(lignePlanning, 1).Font.Bold = False Then
        SommeTotal = SommeTotal + Cells(lignePlanning, 2).Value
        SommeTps = SommeTps + Cells(lignePlanning, 8).Value
        SommeTpsAss = SommeTpsAss + Cells(lignePlanning, 9).Value
        Somme1 = Somme1 + Cells(lignePlanning, 14).Value
        Somme2 = Somme2 + Cells(lignePlanning, 15).Value
        Somme3 = Somme3 + Cells(lignePlanning, 16).Value
        Somme4 = Somme4 + Cells(lignePlanning, 17).Value
        Somme5 = Somme5 + Cells(lignePlanning, 18).Value
        Somme6 = Somme6 + Cells(lignePlanning, 19).Value
        Somme7 = Somme7 + Cells(lignePlanning, 20).Value
        Somme8 = Somme8 + Cells(lignePlanning, 21).Value
        Somme9 = Somme9 + Cells(lignePlanning, 22).Value
        Somme10 = Somme10 + Cells(lignePlanning, 23).Value
        Somme11 = Somme11 + Cells(lignePlanning, 24).Value
        Somme12 = Somme12 + Cells(lignePlanning, 25).Value
        Somme13 = Somme13 + Cells(lignePlanning, 26).Value
        Somme14 = Somme14 + Cells(lignePlanning, 27).Value
        Somme15 = Somme15 + Cells(lignePlanning, 28).Value
        Somme16 = Somme16 + Cells(lignePlanning, 29).Value
        Somme17 = Somme17 + Cells(lignePlanning, 30).Value
        Somme18 = Somme18 + Cells(lignePlanning, 31).Value
        Somme19 = Somme19 + Cells(lignePlanning, 32).Value
        Somme20 = Somme20 + Cells(lignePlanning, 33).Value
        Somme21 = Somme21 + Cells(lignePlanning, 34).Value
        Somme22 = Somme22 + Cells(lignePlanning, 35).Value
        Somme23 = Somme23 + Cells(lignePlanning, 36).Value
        Somme24 = Somme24 + Cells(lignePlanning, 37).Value
        Somme25 = Somme25 + Cells(lignePlanning, 38).Value
        Somme26 = Somme26 + Cells(lignePlanning, 39).Value
        Somme27 = Somme27 + Cells(lignePlanning, 40).Value
        Somme28 = Somme28 + Cells(lignePlanning, 41).Value
        Somme29 = Somme29 + Cells(lignePlanning, 42).Value
        Somme30 = Somme30 + Cells(lignePlanning, 43).Value
        Somme31 = Somme31 + Cells(lignePlanning, 44).Value
        End If
    End If
Next
End Sub
 
Sub Couleur_Jour()
'ordre : 12
Dim Planning As Worksheet
Dim lignePlanning As Integer
Dim colonnePlanning As Integer
 
Set Planning = Worksheets("planning")
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
For lignePlanning = dernierelignePlanning To 5 Step -1
'Ligne total mois : cellule en gris qté = 0 pour chaque jour du mois
    If Cells(lignePlanning, 14).Value <> "" And Cells(lignePlanning, 1).Value = "" Then
        For colonneplanninge = 14 To 44
            If Cells(lignePlanning, colonneplanninge).Value = 0 Then
                Cells(lignePlanning, colonneplanninge).Interior.ThemeColor = xlThemeColorDark2
            End If
        Next
    Else
'Ligne détail du mois : cellule en gris si total mois = 0 pour chaque jour du mois
    If Cells(lignePlanning, 1).Value <> "" And Cells(lignePlanning, 1).Value <> "Série/chassis" Then
        For colonneplanninge = 14 To 44
              If Cells(lignePlanning + 1, colonneplanninge).Interior.ThemeColor = xlThemeColorDark2 Then
                Cells(lignePlanning, colonneplanninge).Interior.ThemeColor = xlThemeColorDark2
               End If
        Next
    End If
    End If
Next
Planning.Range("A1").Select
End Sub
 
Sub Numéro_semaine()
'ordre : 13
Dim Planning As Worksheet
Dim lignePlanning As Integer
Dim mois As Integer
Dim nb_jours As Integer
Dim dernier_jour_mois As Date
 
 
Set Planning = Worksheets("planning")
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
For lignePlanning = 3 To dernierelignePlanning
    If Cells(lignePlanning + 1, 1).Value = "Série/chassis" Then
        'ajouter une ligne
        lignePlanning = lignePlanning + 1
        dernierelignePlanning = dernierelignePlanning + 1
        Rows(lignePlanning).Insert
        Planning.Cells(lignePlanning, 14).Copy
        Planning.Range(Cells(lignePlanning, 14), Cells(lignePlanning, 44)).PasteSpecial Paste:=xlPasteFormats
        colonne = 14
 
        'calcul de l'année
        If (Planning.Cells(lignePlanning + 2, 12) = "juillet" Xor Planning.Cells(lignePlanning + 2, 12) = "août" Xor Planning.Cells(lignePlanning + 2, 12) = "septembre" _
                Xor Planning.Cells(lignePlanning + 2, 12) = "octobre" Xor Planning.Cells(lignePlanning + 2, 12) = "novembre" Xor Planning.Cells(lignePlanning + 2, 12) = "décembre") And lignePlanning <= 1000 Then
                année = Planning.Range("T1") - 1
        Else: année = Planning.Range("T1")
        End If
 
        'calcul de la semaine de la 1ere colonne
        Planning.Cells(lignePlanning, 14) = Format(Planning.Cells(lignePlanning + 1, 14) & " " & Planning.Cells(lignePlanning + 2, 12) & " " & année, "WW", vbMonday, vbFirstFourDays)
 
        'calcul de la colonne max par mois
        mois = Month(Planning.Cells(lignePlanning + 1, 14) & " " & Planning.Cells(lignePlanning + 2, 12) & " " & année) + 1
        dernier_jour_mois = DateSerial(année, mois, 1) - 1
        nb_jours = Day(dernier_jour_mois)
 
        'calcul de la semaine de la 2eme colonne à la dernière colonne
        For semaine = 15 To nb_jours + 13
            Planning.Cells(lignePlanning, semaine) = Format(Planning.Cells(lignePlanning + 1, semaine) & " " & Planning.Cells(lignePlanning + 2, 12) & " " & année, "WW", vbMonday, vbFirstFourDays)
            'si le n° de semaine de la colonne 14 (jour n°1) est différent de la colonne 15 (jour n°2) alors mise en forme de la colonne 14 (jour 1)
            If Planning.Cells(lignePlanning, semaine).Value <> Planning.Cells(lignePlanning, semaine - 1).Value And semaine = 15 Then
                Planning.Cells(lignePlanning, colonne).HorizontalAlignment = xlCenter
                Planning.Cells(lignePlanning, colonne).Borders.Weight = xlMedium
                colonne = semaine
            End If
            'si le n° de semaine de la colonne est différent de la colonne précendente alors mise en forme de la semaine précédente
            If Planning.Cells(lignePlanning, semaine).Value <> Planning.Cells(lignePlanning, semaine - 1).Value And semaine > 15 Then
                Planning.Range(Cells(lignePlanning, colonne + 1), Cells(lignePlanning, semaine - 1)).Value = ""
                Planning.Range(Cells(lignePlanning, colonne), Cells(lignePlanning, semaine - 1)).Merge
                Planning.Range(Cells(lignePlanning, colonne), Cells(lignePlanning, semaine - 1)).HorizontalAlignment = xlCenter
                Planning.Range(Cells(lignePlanning, colonne), Cells(lignePlanning, semaine - 1)).Borders.Weight = xlMedium
                colonne = semaine
            End If
            'si le n° de la colonne est la dernière colonne du mois alors mise en forme de la semaine encours
            If semaine = nb_jours + 13 Then
                If colonne <> semaine Then
                    Planning.Range(Cells(lignePlanning, colonne + 1), Cells(lignePlanning, semaine)).Value = ""
                    Planning.Range(Cells(lignePlanning, colonne), Cells(lignePlanning, semaine)).Merge
                End If
                Planning.Range(Cells(lignePlanning, colonne), Cells(lignePlanning, semaine)).HorizontalAlignment = xlCenter
                Planning.Range(Cells(lignePlanning, colonne), Cells(lignePlanning, semaine)).Borders.Weight = xlMedium
 
            End If
            Planning.Rows(lignePlanning).Font.Size = 22
        Next
    End If
Next
End Sub
 
 
Sub Somme_semaine()
'ordre : 14
 
Dim Planning As Worksheet
Dim dernierelignePlanning As Integer
Dim nb_semaine As Integer
Dim num_ligne_totaux As Integer
 
Set Planning = Worksheets("Planning")
 
dernierelignePlanning = Planning.UsedRange.Rows.Count
For ligne = 4 To dernierelignePlanning
    'sert à retenir le n° de la ligne d'entête de chaque mois pour par la suite savoir lorsque nous changeons de n° de semaine
    If Planning.Cells(ligne + 1, 1).Value = "Série/chassis" Then
        num_ligne_semaine = ligne
    End If
    'si la ligne de la 1ère colonne est vide mais pas la 2e colonne, c'est que le mois est terminé alors
    If Planning.Cells(ligne, 1).Value = "" And Planning.Cells(ligne, 2).Value <> "" Then
        nb_semaine = Planning.Cells(ligne, 14).Value
        'si les colonnes 14 et 15 n'ont pas le même n° de semaine alors le total de la 1ère semaine est égal au 1er jour
        If Planning.Cells(num_ligne_semaine, 14) <> "" And Planning.Cells(num_ligne_semaine, 15) <> "" Then
            Planning.Cells(ligne + 1, 14).Value = nb_semaine
            Planning.Cells(ligne + 1, 14).Font.Bold = True
            nb_semaine = Planning.Cells(ligne, 14).Value
        End If
 
        For colonne = 15 To 44
            'si à partir du 2e jour de fab, nous ne changeons pas de n° de sem
            If Planning.Cells(num_ligne_semaine, colonne) = "" Then
                'alors le total de la semaine est égal au jour plus le total précédement calculé
                nb_semaine = nb_semaine + Planning.Cells(ligne, colonne).Value
            Else
                'sinon le total de la semaine doit être inscris dans la colonne précédente
                ' et le calcul du total est réinitialisé avec la fab de cette journée
                Planning.Cells(ligne + 1, colonne - 1).Value = nb_semaine
                Planning.Cells(ligne + 1, colonne - 1).Font.Bold = True
                nb_semaine = Planning.Cells(ligne, colonne).Value
            End If
        Next
        'Si nous arrivons à la dernière colonne alors
        If colonne - 1 = 44 Then
            Planning.Cells(ligne + 1, colonne - 1).Value = nb_semaine
            Planning.Cells(ligne + 1, colonne - 1).Font.Bold = True
            nb_semaine = 0
        End If
    End If
Next
End Sub
 
 
 
Sub colonne_semaine()
'ordre : 15
Dim Planning As Worksheet
Dim dernierelignePlanning As Integer
Dim nb_semaine As Integer
Dim num_ligne As Integer
 
Set Planning = Worksheets("Planning")
 
dernierelignePlanning = Planning.UsedRange.Rows.Count
 
For num_ligne = 4 To dernierelignePlanning
 
' bordures standards
    If Planning.Cells(num_ligne, 1) <> "" And Planning.Cells(num_ligne, 1) <> "Série/chassis" Then
        Planning.Range(Cells(num_ligne, 1), Cells(num_ligne, 44)).Borders.Weight = xlThin
        Planning.Range(Cells(num_ligne, 46), Cells(num_ligne, 55)).Borders.Weight = xlThin
    End If
 
'bordures si changement de n° de semaine
    If Planning.Cells(num_ligne, 1) = "Série/chassis" Then
        For nb_semaine = 14 To 44
            If Planning.Cells(num_ligne - 1, nb_semaine).Value <> "" Then
                Planning.Cells(num_ligne, nb_semaine).Borders(xlEdgeLeft).Weight = xlMedium
                Else
                    Planning.Cells(num_ligne, nb_semaine).Borders(xlEdgeLeft).Weight = xlThin
                    Range(Cells(num_ligne, 14), Cells(num_ligne, 44)).Interior.Color = 16751103
            End If
        Next
    End If
    If Planning.Cells(num_ligne, 1) <> "" And Planning.Cells(num_ligne, 1) <> "Série/chassis" Then
        For nb_semaine = 14 To 44
            If Planning.Cells(num_ligne - 1, nb_semaine).Borders(xlEdgeLeft).Weight = xlMedium Then
                Planning.Cells(num_ligne, nb_semaine).Borders(xlEdgeLeft).Weight = xlMedium
            End If
        Next
    End If
 
'bordures si changement de n° de série
    If Planning.Cells(num_ligne, 2).Font.Bold = True And Cells(num_ligne, 1).Value <> "Série/chassis" Then
        Planning.Range(Cells(num_ligne - 1, 1), Cells(num_ligne - 1, 44)).Borders(xlEdgeBottom).Weight = xlMedium
        Planning.Range(Cells(num_ligne - 1, 46), Cells(num_ligne - 1, 55)).Borders(xlEdgeBottom).Weight = xlMedium
    End If
 
'couleurs mois et n° de semaine
    If Planning.Cells(num_ligne + 1, 1) = "Série/chassis" Or Planning.Cells(num_ligne + 2, 1) = "Série/chassis" Then
        Range(Cells(num_ligne, 14), Cells(num_ligne, 44)).Interior.ThemeColor = xlThemeColorDark2
    End If
Next
Application.Calculation = xlAutomatic
ThisWorkbook.RefreshAll
 
End Sub
 
Sub DateProdCde()
Dim i, j, DernièreLigne, DernièreColonne
 
Dim WB_Planning As Workbook
Dim BDD As Worksheet
 
 
Set WB_Planning = ActiveWorkbook
Set BDD = WB_Planning.Worksheets("BDD")
 
BDD.Activate
 
ligne_BDD = BDD.UsedRange.Rows.Count
 
    ActiveSheet.Range("A2").Select           '*******
    Selection.CurrentRegion.Select            '*******
    Set tbl = ActiveCell.CurrentRegion       '*******
    DernièreLigne = tbl.Rows.Count           '*******
    DernièreColonne = tbl.Columns.Count  '*******
    Cells(2, 1).Select
    ligne_àcopier = 1
    Open "\\srv-x3v7\Sage\LOUIPRD\dossiers\LSN\configurateur\date_production_commande_loua.csv" For Output As #1
 
    For i = 2 To ligne_BDD
    ligne_àcopier = ligne_àcopier + 1
        ligne = ""
        If (CDE <> Cells(ligne_àcopier, 9) And Cells(ligne_àcopier, 9) Like "B*") Then 'Ne prendre que les lignes dont la commande est différente de la ligne du dessus et qui ont un numéro de commande
            If (BDD.Cells(ligne_àcopier, 3) > Date) Then 'Ne prendre que les lignes dont la date de prodution est supérieur à la date du jour
                ligne = Cells(ligne_àcopier, 9).Value & ";" & Format(BDD.Cells(ligne_àcopier, 3), "dd/mm/yyyy")
                    Print #1, ligne
            End If
        End If
        CDE = Cells(ligne_àcopier, 9).Value
    Next i
    Close
End Sub
 
Sub DateProdOf()
Dim i, j, DernièreLigne, DernièreColonne
 
Dim WB_Planning As Workbook
Dim BDD As Worksheet
 
 
Set WB_Planning = ActiveWorkbook
Set BDD = WB_Planning.Worksheets("BDD")
 
BDD.Activate
 
ligne_BDD = BDD.UsedRange.Rows.Count
 
    ActiveSheet.Range("A2").Select           '*******
    Selection.CurrentRegion.Select            '*******
    Set tbl = ActiveCell.CurrentRegion       '*******
    DernièreLigne = tbl.Rows.Count           '*******
    DernièreColonne = tbl.Columns.Count  '*******
    Cells(2, 1).Select
    ligne_àcopier = 1
    Open "\\srv-x3v7\Sage\LOUIPRD\dossiers\LSN\configurateur\date_production_of_loua.csv" For Output As #1
 
    For i = 2 To ligne_BDD
    ligne_àcopier = ligne_àcopier + 1
        ligne = ""
        If (CDE <> Cells(ligne_àcopier, 6) And Cells(ligne_àcopier, 6) Like "O*") Then 'Ne prendre que les lignes dont l OF est différent de la ligne du dessus et qui ont un numéro de OF
            If (BDD.Cells(ligne_àcopier, 3) > Date - 10) Then 'Ne prendre que les lignes dont la date de prodution est supérieur à la date du jour - 10
                ligne = Cells(ligne_àcopier, 6).Value & ";" & Format(BDD.Cells(ligne_àcopier, 3), "dd/mm/yyyy")
                    Print #1, ligne
            End If
        End If
        of = Cells(ligne_àcopier, 6).Value
    Next i
    Close
End Sub
 
Sub DateProdStr()
Dim i, j, DernièreLigne, DernièreColonne
 
Dim WB_Planning As Workbook
Dim BDD As Worksheet
 
 
Set WB_Planning = ActiveWorkbook
Set BDD = WB_Planning.Worksheets("BDD")
 
BDD.Activate
 
ligne_BDD = BDD.UsedRange.Rows.Count
 
    ActiveSheet.Range("A2").Select           '*******
    Selection.CurrentRegion.Select            '*******
    Set tbl = ActiveCell.CurrentRegion       '*******
    DernièreLigne = tbl.Rows.Count           '*******
    DernièreColonne = tbl.Columns.Count  '*******
    Cells(2, 1).Select
    ligne_àcopier = 1
    Open "\\srv-x3v7\Sage\LOUIPRD\dossiers\LSN\configurateur\date_production_structure_loua.csv" For Output As #1
 
    For i = 2 To ligne_BDD
    ligne_àcopier = ligne_àcopier + 1
        ligne = ""
        If (CDE <> Cells(ligne_àcopier, 23) And Cells(ligne_àcopier, 23) Like "O*") Then 'Ne prendre que les lignes dont l OF est différent de la ligne du dessus et qui ont un numéro de commande
            If (BDD.Cells(ligne_àcopier, 3) > Date) Then 'Ne prendre que les lignes dont la date de prodution est supérieur à la date du jour
                ligne = Cells(ligne_àcopier, 23).Value & ";" & Format(BDD.Cells(ligne_àcopier, 3), "dd/mm/yyyy")
                    Print #1, ligne
            End If
        End If
        CDE = Cells(ligne_àcopier, 23).Value
    Next i
    Close
End Sub
 
Sub modif_MH_prevu_quotidien()
 
Dim WB_Planning As Workbook
Dim JT As Worksheet
Dim Planning As Worksheet
Dim i As Integer
Dim Nb_Jour As Integer
Set WB_Planning = ActiveWorkbook
Set JT = WB_Planning.Worksheets("Liste jour travaillé")
Set Planning = WB_Planning.Worksheets("Planning")
 
nb_prévi = JT.UsedRange.Rows.Count
i = JT.Range("t1").Value - 43281
 
JT.Activate
JT.Calculate
JT.Calculate
JT.Calculate
'modifier le nombre de MH prévu
For Destination = i + 8 To nb_prévi
    JT.Cells(Destination, 15) = JT.Cells(Destination, 18)
Next
Planning.Activate
 
End Sub

Module 2:

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
Sub Actualiser_Planning()
Application.Calculation = xlManual
Application.ScreenUpdating = False
 
    'stop macro si ligne vide à la fin de liste jour travaillé
    Dim Jour_Travail As Worksheet
    Dim BDD As Worksheet
    Set Jour_Travail = Worksheets("Liste jour travaillé")
    Set BDD = Worksheets("BDD")
    NB_Ligne_Cadence = Jour_Travail.UsedRange.Rows.Count
    If Jour_Travail.Cells(NB_Ligne_Cadence, 1) = "" Then
        Call informer_bug_ligne_vide
        Exit Sub
    End If
 
    Call MAJ_BDD '----------------MAJ planning (OF, cde et Forecast)
    Call remplir_tpsStd '-----ramene le temps d'assemblage pour chaque ligne
    Call remplir_mois_fab '---calcul le mois de fabrication
 
    'stop la macro s'il y a un dépassement de capacité
    NB_ligne_BDD = BDD.UsedRange.Rows.Count
    NB_Ligne_Cadence = Jour_Travail.UsedRange.Rows.Count
    If BDD.Cells(NB_ligne_BDD, 35) > Jour_Travail.Cells(NB_Ligne_Cadence, 8) Then
        Call informer_bug_dépassement_capacité
        Exit Sub
    End If
 
    Call Date_liv_fab
    Call Ecart_date_liv
    Call remplir_planning
    Call format_planning
    Call grouper
    Call grouper_cde_clt
    Call CalculSérie
    Call CalculMois
    Call Couleur_Jour
    Call Numéro_semaine
    Call Somme_semaine
    Call colonne_semaine
    Call DateProdCde
    Call DateProdOf
    Call DateProdStr
    'Call modif_MH_prevu_quotidien
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Sub Actualiser_Planning_modif_tps_ouverture()
Application.Calculation = xlManual
Application.ScreenUpdating = False
    Call remplir_tpsStd
    Call remplir_mois_fab
    Call Date_liv_fab
    Call Ecart_date_liv
    Call remplir_planning
    Call format_planning
    Call grouper
    Call grouper_cde_clt
    Call CalculSérie
    Call CalculMois
    Call Couleur_Jour
    Call Numéro_semaine
    Call Somme_semaine
    Call colonne_semaine
    Call DateProdCde
    Call DateProdOf
    Call DateProdStr
    'Call modif_MH_prevu_quotidien
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Sub Simulation()
Application.Calculation = xlManual
Application.ScreenUpdating = False
 
Dim Jour_Travail As Worksheet
Dim BDD As Worksheet
Set Jour_Travail = Worksheets("Liste jour travaillé")
Set BDD = Worksheets("BDD")
NB_Ligne_Cadence = Jour_Travail.UsedRange.Rows.Count
 
    If Jour_Travail.Cells(NB_Ligne_Cadence, 1) = "" Then
        MsgBox "Vous avez des lignes vides à la fin de l'onglet liste jour travaillé ! Veuillez supprimer ces lignes et relancer la simulation."
        Exit Sub
    End If
 
    'Call MAJ_BDD
    Call remplir_tpsStd
    Call remplir_mois_fab
 
    'stop la macro s'il y a un dépassement de capacité
    NB_ligne_BDD = BDD.UsedRange.Rows.Count
    NB_Ligne_Cadence = Jour_Travail.UsedRange.Rows.Count
    If BDD.Cells(NB_ligne_BDD, 35) > Jour_Travail.Cells(NB_Ligne_Cadence, 8) Then
        MsgBox "Vous prévoyer plus de MH que le takttime et le temps d'ouverture ne le permettent ! Veuillez augmenter la capacité de production."
        Exit Sub
    End If
 
    Call Date_liv_fab
    Call Ecart_date_liv
    Call remplir_planning
    Call format_planning
    Call grouper
    Call grouper_cde_clt
    Call CalculSérie
    Call CalculMois
    Call Couleur_Jour
    Call Numéro_semaine
    Call Somme_semaine
    Call colonne_semaine
    'Call DateProdCde
    'Call DateProdOf
    'Call modif_MH_prevu_quotidien
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
 
 
Sub Sauvegarder_Informer()
    ActiveWorkbook.Save
 
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim olFormatHTML As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
 strbody = "ALERTE modification planning"
On Error Resume Next
    With OutMail
        .To = "vadrubal@mobilhomelouisiane.com;"
        .CC = ""
        .BCC = ""
        .Importance = olImportanceHigh
        .Subject = "ALERTE modification planning"
        .BodyFormat = olFormatHTML
      .HTMLBody = "<HTML><Font Face=calibri Size=3>Bonjour, <BR><BR><BODY>Ce message est un mail automatique, il vous informe que <B>" & Environ("username") & " a modifié le planning de fabrication" _
        & "<A href=" & """" & "Y:\Ordonnancement\PLANNING FERME-PREVI\Accueil planning.xlsm" & """" & "><B>Accéder au planning de fabrication.</B></A>" & Chr(10) & "<BR><BR>Cordialement</BODY></FONT></HTML>"
        .Display
    End With
        On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Module 3 :

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
Sub Bouton3_Cliquer()
Application.ScreenUpdating = False
Dim WB_Planning As Workbook
Dim WB_Declaration As Workbook
Dim JT As Worksheet
Dim Declaration As Worksheet
Dim i As Integer
Dim Nb_Jour As Integer
 
Set WB_Planning = ActiveWorkbook
Set JT = WB_Planning.Worksheets("Liste jour travaillé")
 
JT.Unprotect
 
If JT.Range("U2").Value <> Format(Now(), "dd.mm.yy") Then
 
Workbooks.Open Filename:="Y:\Ordonnancement\PLANNING FERME-PREVI\declaration_production.xls"
Set WB_Declaration = Workbooks("declaration_production.xls")
Set Declaration = WB_Declaration.Worksheets("Sheet1")
Nb_Jour = Declaration.UsedRange.Rows.Count
nb_prévi = JT.UsedRange.Rows.Count
 
'enlever les fusions de la feuille déclaration de production
Declaration.Range(Cells(1, 1), Cells(Nb_Jour, 5)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
'Trier les déclarations par date notamment pour les déclarations manuelles de la LOU B
Columns("A:D").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B:B") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'renseigner les quantités de MH fabriqués
 
i = JT.Range("U4").Value - 43646
For Destination = 2 To i
    If JT.Cells(Destination, 2) = JT.Range("U4") Then
    Exit For
    Else
        For Source = 2 To Nb_Jour
        If JT.Cells(Destination, 2) < CDate(Declaration.Cells(Source, 2)) Then
            JT.Cells(Destination, 9).Value = 0
            Exit For
        End If
        If JT.Cells(Destination, 2) = CDate(Declaration.Cells(Source, 2)) And Declaration.Cells(Source, 1).Value = JT.Range("u5").Value Then
            JT.Cells(Destination, 9) = Declaration.Cells(Source, 4).Value
            Exit For
        End If
        Next
    End If
Next
WB_Declaration.Close False
 
JT.Range("u2").Value = Format(Now(), "dd.mm.yy")
JT.Protect
End If
Application.ScreenUpdating = True
End Sub
 
Sub Afficher()
Dim BDD As Worksheet
Dim Actualiser As Worksheet
Set BDD = Worksheets("BDD")
Set Actualiser = Worksheets("Actualiser le planning")
 
BDD.Visible = 1
BDD.Unprotect
Actualiser.Visible = 1
Actualiser.Unprotect
End Sub

Module 4:

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
Sub MAJ_Avancement()
 
Call avancement_jour
Call avancement_Numéro_MH
 
End Sub
 
Sub avancement_jour()
 
Dim avancement As Worksheet
Dim JT As Worksheet
 
Set avancement = Worksheets("Avancement")
Set JT = Worksheets("Liste jour travaillé")
 
 
ligne = JT.Range("T1") - JT.Range("B2") + 2
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("B20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
 
ligne = avancement.Range("B20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("C20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
 
ligne = avancement.Range("C20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("D20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
 
ligne = avancement.Range("D20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("E20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
 
ligne = avancement.Range("E20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("F20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
ligne = avancement.Range("F20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("G20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
ligne = avancement.Range("G20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("H20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
ligne = avancement.Range("H20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("I20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
ligne = avancement.Range("I20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("J20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
ligne = avancement.Range("J20") - JT.Range("B2") + 3
For liste_JT = ligne To 366
    If JT.Cells(liste_JT, 4) = 1 Then
        avancement.Range("K20") = JT.Cells(liste_JT, 2)
        Exit For
    End If
Next
 
End Sub
 
Sub avancement_Numéro_MH()
 
Dim avancement As Worksheet
Dim BDD As Worksheet
 
Set avancement = Worksheets("Avancement")
Set BDD = Worksheets("BDD")
 
derniereligneBDD = BDD.UsedRange.Rows.Count
For ligne = 1 To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("B20") Then
        avancement.Range("B21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("C20") Then
        avancement.Range("C21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("D20") Then
        avancement.Range("D21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("E20") Then
        avancement.Range("E21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("F20") Then
        avancement.Range("F21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("G20") Then
        avancement.Range("G21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("H20") Then
        avancement.Range("H21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("I20") Then
        avancement.Range("I21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
 
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("J20") Then
        avancement.Range("J21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
 
Next
 
For ligne = i To derniereligneBDD
    If BDD.Cells(ligne, 3) = avancement.Range("K20") Then
        avancement.Range("K21") = BDD.Cells(ligne, 34)
        i = ligne
        Exit For
    End If
Next
End Sub

Module 5 :

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
Sub informer_bug_ligne_vide()
 
Dim Planning As Worksheet
Set Planning = Worksheets("Planning")
Dim Name As String
 
'Dim WordApp As objet
'Dim WordDoc As objet
 
Set WordApp = CreateObject("Word.Application")     '-- ouvre une session Word
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add    '-- crée un nouveau document
 
Message = "Des lignes vides sont apparues à la fin de l'onglet liste jour travaillé du planning de " & Planning.Range("V1") & ". Merci de bien vouloir les supprimer."
 
With WordApp.Selection
    .Font.Size = 5
    .Font.Name = "ActiveFax"
    .TypeText Text:="@F111administrateur@test.com@@F212patrick@test.com@@F311Administrateur@@F307 Erreur dans la mise a jour du planning de" & Planning.Range("V1") & "@"
    .TypeParagraph
    .Font.Size = 10
    .Font.Name = "Arial"
    .Text = Message
End With
 
WordDoc.SaveAs Filename:="\\SRV-X3V7\Faxout\Anomalie MaJ Planning liee a des lignes vides.doc"
 
WordApp.Quit (wdDoNotSaveChanges)
 
End Sub
 
 
Sub informer_bug_dépassement_capacité()
 
Dim Planning As Worksheet
Set Planning = Worksheets("Planning")
Dim Name As String
 
'Dim WordApp As objet
'Dim WordDoc As objet
 
Set WordApp = CreateObject("Word.Application")     '-- ouvre une session Word
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add    '-- crée un nouveau document
 
Message = "Il y a un dépassement de capacité dans le planning de " & Planning.Range("V1") & ". Merci de bien vouloir soit ajouter des journées de travail à la fin de l'onglet Liste jour travaillé, soit augmenter de la capacité de production sur les journées déjà existantes."
 
With WordApp.Selection
    .Font.Size = 5
    .Font.Name = "ActiveFax"
    .TypeText Text:="@F111administrateur@test.com@@F212patrick@test.com@@F311Administrateur@@F307 Erreur dans la mise a jour du planning de" & Planning.Range("V1") & "@"
    .TypeParagraph
    .Font.Size = 10
    .Font.Name = "Arial"
    .Text = Message
End With
WordDoc.SaveAs Filename:="\\SRV-X3V7\Faxout\Anomalie MaJ Planning liee a un dépassement de capacite.doc"
 
WordApp.Quit (wdDoNotSaveChanges)
 
End Sub

**Patrice740** · 31/03/2020, 18h35

Bonjour

Tu emploies très souvent (10 fois) une syntaxe incorrecte qui peut entrainer une mauvaise interprétation du type par Excel :

Code :

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

Range("A1") = Format$(.... , "....")

En effet, Format() renvoie une chaine de caractère qui dans ton cas représente un nombre sous forme textuelle, et dans ce cas Excel va essayer d'interpréter le type de donnée.

Format nombre se change en [$-40C]j*

Macros et VBA Excel

Discussions similaires

Partager

Partager