Dispatching NOM Prénom dans les onglets suivant Dates

Version imprimable

06/06/2020, 02h32
roby68

1 pièce(s) jointe(s)

Dispatching NOM Prénom dans les onglets suivant Dates

Bonjour,

Je suis coincé sur le dispatching du NOM Prénom dans les onglets Jaunes et Bleus.
J'aimerais, lorsque l'on valide la saisie ( UserForm = frmIDPPSMJ ), que le NOM et Prénom ( colonne C ) s'inscrive dans les onglet en jaune et en bleu suivant deux dates ( * ).

Exemple : NOM Prénom 01

Date Pose ( inscription dans les onglets couleur Jaune ) ici 02/06/2020 dans l'onglet Pose 06
et
Date Théorique ( inscription dans les onglets couleur Bleu ) ici 02/09/2020 dans l'onglet Fin 09

Où cela se complique, c'est lorsque l'on veut modifier et faire apparaitre le NOM Prénom 05 pour l'exemple, dans les onglets couleur bleu toujours, cette fois pas à l'aide de la date Théorique mais avec la Date réelle fin en n'oubliant pas d'effacer la correspondance Date Théorique saisie auparavant ( bouton Modifier pour cette tâche dans l'UserForm avec les données déjà existantes).

Merci d'avance Roby
06/06/2020, 11h33
mfoxy

Bonjour,

Très peu de membres ouvrent les pièces jointes.
Pour des raisons évidentes de sécurités.

Il serait préférable que vous postiez : votre code actuel , des explications simples, qq printscreen de vos tables in/out, nom de feuille,...

Bav

Bonjour,

Si j'ai bien compris, explications avec une petite vidéo
Pièce jointe 570926

Le fichier
Pièce jointe 570927

Le code dans le module du formulaire

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
Dim Mois As String
Dim Col As Long
Dim DatePose As Date, DateTheor As Date, DateFin As Date
 
Private Sub CommandButton1_Click() ' Bouton Valider
    Application.ScreenUpdating = False
    Nom = frmIDPPSMJ.ComboBox1.Value
    Sheets("MENU").Select
    Range("Tableau1[[#Headers],[NOM et Prénom]]").Select
    Selection.End(xlDown).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
    ActiveCell.Offset(1, 0).Select
    ActiveCell = frmIDPPSMJ.ComboBox1.Value
    ActiveCell.Offset(0, 1) = frmIDPPSMJ.TextBox1.Value
    ActiveCell.Offset(0, 2) = Format(frmIDPPSMJ.TextBox2.Value, "mm/dd/yyyy") 'Date de naissance
    ActiveCell.Offset(0, 3) = Format(frmIDPPSMJ.TextBox3.Value, "mm/dd/yyyy") 'Date pose
    DatePose = DateSerial(Year(frmIDPPSMJ.TextBox3.Value), Month(frmIDPPSMJ.TextBox3.Value), Day(frmIDPPSMJ.TextBox3.Value))
    MoisPose = Format(Month(frmIDPPSMJ.TextBox3.Value), "00")
    If TextBox5.Value <> "" Then
        ActiveCell.Offset(0, 5) = Format(frmIDPPSMJ.TextBox5.Value, "mm/dd/yyyy") 'Date réelle de fin
        DateFin = DateSerial(Year(frmIDPPSMJ.TextBox5.Value), Month(frmIDPPSMJ.TextBox5.Value), Day(frmIDPPSMJ.TextBox5.Value))
        MoisFin = Format(Month(frmIDPPSMJ.TextBox5.Value), "00")
    Else
        If TextBox4.Value <> "" Then
            ActiveCell.Offset(0, 4) = Format(frmIDPPSMJ.TextBox4.Value, "mm/dd/yyyy") 'Date théorique
            DateTheor = DateSerial(Year(frmIDPPSMJ.TextBox4.Value), Month(frmIDPPSMJ.TextBox4.Value), Day(frmIDPPSMJ.TextBox4.Value))
            MoisTheor = Format(Month(frmIDPPSMJ.TextBox4.Value), "00")
        End If
    End If
    Call TriALPHA
    Range("C4").Value = frmIDPPSMJ.ComboBox1.Value
    Unload frmIDPPSMJ
 
    'Recopie dans Feuille jaune "Pose"
    Feuille = "Pose " & MoisPose
    With Sheets(Feuille)
        .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
        Set d = .Columns(3).Find(DatePose)
        Col = 4
        Do
            If .Cells(d.Row, Col) <> "" Then Col = Col + 1
        Loop While .Cells(d.Row, Col) <> ""
        .Cells(d.Row, Col) = Nom
    End With
    Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
 
    'Recopie dans Feuille bleue "Fin"
    If DateFin = 0 Then 'S'il n'y a pas la date de fin
        Feuille = "Fin " & MoisTheor
        With Sheets(Feuille) 'alors on cherche la date théorique
            .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
            Set d = .Columns(3).Find(DateTheor)
            Col = 4
            Do
                If .Cells(d.Row, Col) <> "" Then Col = Col + 1
            Loop While .Cells(d.Row, Col) <> ""
            .Cells(d.Row, Col) = Nom
        End With
        Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
 
    Else 'Sinon on supprime la date théorique
        'Feuille = "Fin " & MoisTheor
        'With Sheets(Feuille) 'alors on cherche la date théorique
            '.Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
            'Set d = .Columns(3).Find(DateTheor)
            'Col = 4
            'Do
                'If .Cells(d.Row, Col) <> Nom Then Col = Col + 1
            'Loop While .Cells(d.Row, Col) <> ""
            '.Cells(d.Row, Col).ClearContents
        'End With
        'Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
 
        Feuille = "Fin " & MoisFin
        With Sheets(Feuille) 'on cherche la date de fin
            .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
            Set d = .Columns(3).Find(DateFin)
            Col = 4
            Do
                If .Cells(d.Row, Col) <> "" Then Col = Col + 1
            Loop While .Cells(d.Row, Col) <> ""
            .Cells(d.Row, Col) = Nom
        End With
        Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
    End If
    Set d = Nothing
End Sub
 
Private Sub CommandButton2_Click() ' Bouton  Annuler
Unload frmIDPPSMJ
End Sub
 
Private Sub CommandButton3_Click() 'Bouton Modifier
    'on efface le nom dans les feuilles "Pose" et "fin"
    If ComboBox1.Text <> "" Then
        Nom = ComboBox1.Text
        With Sheets("MENU")
        Set n1 = .Columns(3).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
            If Not n1 Is Nothing Then
                TextBox3.Text = .Cells(n1.Row, "F")
                TextBox4.Text = .Cells(n1.Row, "G")
                If .Cells(n1.Row, "H") <> "" Then TextBox5.Text = .Cells(n1.Row, "H")
            End If
 
            '****************************************************************************************************************
            DatePose = TextBox3.Text
            MoisPose = Format(Month(frmIDPPSMJ.TextBox3.Value), "00")
            Feuille = "Pose " & MoisPose
            With Sheets(Feuille)
                .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
                Set d = .Columns(3).Find(DatePose)
                If Not d Is Nothing Then
                    Set n2 = .Rows(d.Row).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
                    If Not n2 Is Nothing Then
                        .Cells(d.Row, n2.Column).ClearContents
                    End If
                End If
                Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
            End With
 
            '****************************************************************************************************************
            If TextBox4.Text <> "" Then
                DateTheor = TextBox4.Text
                MoisTheor = Format(Month(frmIDPPSMJ.TextBox4.Value), "00")
                Feuille = "Fin " & MoisTheor
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
                    Set d = .Columns(3).Find(DateTheor)
                    If Not d Is Nothing Then
                        Set n2 = .Rows(d.Row).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
                        If Not n2 Is Nothing Then
                            .Cells(d.Row, n2.Column).ClearContents
                        End If
                    End If
                    Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
                End With
            End If
 
            '****************************************************************************************************************
            If TextBox5.Text <> "" Then
                DateFin = TextBox5.Text
                MoisTheor = Format(Month(frmIDPPSMJ.TextBox5.Value), "00")
                Feuille = "Fin " & MoisTheor
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value 'on remplace les dates obtenues par formules par leurs valeurs
                    Set d = .Columns(3).Find(DateFin)
                    If Not d Is Nothing Then
                        Set n2 = .Rows(d.Row).Find(Nom, , LookIn:=xlValues, lookat:=xlWhole)
                        If Not n2 Is Nothing Then
                            .Cells(d.Row, n2.Column).ClearContents
                        End If
                    End If
                    Creation_Calendrier_du_mois 'on réécrit les formules du calcul des dates
                End With
            End If
        End With
    End If
    Sheets("Menu").Rows(n1.Row).Delete 'on efface la ligne dans la feuille "MENU"
    Set n1 = Nothing
    Set n2 = Nothing
    Set d = Nothing
End Sub

cdlt

4 pièce(s) jointe(s)

Dispatching NOM Prénom dans les onglets suivant Dates

Bonjour le Forum, ARTURO83,

OUI, pas de soucis, ci après des captures écran et codes VBA correspondants :
Si cela peut aider sans ouvrir le fichier.

Rappel: si dans les onglets Jaunes et Bleus la première colonne est déjà prise, inscrire le NOM et Prénom dans la deuxième colonne à droite de celle-ci et ainsi de suite.

Code du UserForm ( IDPPSMJ ):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub CommandButton1_Click() ' Bouton Valider
Application.ScreenUpdating = False
Sheets("MENU").Select
    Range("Tableau1[[#Headers],[NOM et Prénom]]").Select
    Selection.End(xlDown).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
ActiveCell.Offset(1, 0).Select
ActiveCell = frmIDPPSMJ.ComboBox1.Value
ActiveCell.Offset(0, 1) = frmIDPPSMJ.TextBox1.Value
ActiveCell.Offset(0, 2) = Format(frmIDPPSMJ.TextBox2.Value, "mm/dd/yyyy")
ActiveCell.Offset(0, 3) = Format(frmIDPPSMJ.TextBox3.Value, "mm/dd/yyyy")
ActiveCell.Offset(0, 4) = Format(frmIDPPSMJ.TextBox4.Value, "mm/dd/yyyy")
ActiveCell.Offset(0, 5) = Format(frmIDPPSMJ.TextBox5.Value, "mm/dd/yyyy")
Call TriALPHA
'*********************************************************************
' ici - Code NOM et Prénom dans Onglet Jaune et Bleu correspondant aux deux dates :
 
 
 
'*********************************************************************
Range("C4").Value = frmIDPPSMJ.ComboBox1.Value
Application.ScreenUpdating = True
Unload frmIDPPSMJ
End Sub
 
Private Sub CommandButton2_Click() ' Bouton  Annuler
Unload frmIDPPSMJ
End Sub
 
Private Sub CommandButton4_Click()
usfCal1.Show
End Sub
 
Private Sub CommandButton5_Click()
usfCal2.Show
End Sub
 
Private Sub CommandButton6_Click()
usfCal3.Show
End Sub

Bien cordialement Roby

07/06/2020, 14h17
ARTURO83

Bonjour,

Avez-vous testé ma proposition jointe?
07/06/2020, 16h02
roby68

Dispatching NOM Prénom dans les onglets suivant Dates

rRe le forum, ARTURO83,

Oui, viens juste de tester,
ton code à l'air de bien fonctionner, je verrais sur les postes du bureau demain.
Je trouve le concept de la vidéo correspondante, très cool.

Je te remercie encore pour ta réactivité et la qualité de cette discussion.

Bonne fin de Dimanche à tous

Roby
07/06/2020, 16h34
roby68

Dispatching NOM Prénom dans les onglets suivant Dates

Re ARTURO83

Toutefois, à quoi sert le code " Creation_Calendrier_du_mois() " ?

Merci encore

Roby
07/06/2020, 17h25
ARTURO83

Citation:

Toutefois, à quoi sert le code " Creation_Calendrier_du_mois() " ?

Tout d'abord, les dates de chaque feuilles étant créées par formules et étant dépendantes de la cellule L2 "l'année à traiter" de la feuille "MENU", à chaque changement d'année, tous les calendriers mis à jour automatiquement.
Seulement pour exécuter le travail demandé, "copier les noms dans les feuilles de destination à la bonne date", et que les recherche sur les dates ne sont pas toujours évidentes (un coup parce que la date n'est pas au bon format, un coup parce que c'est le mois qui inversé avec le jour, etc..), j'ai opté pour un figeage de valeurs des dates avant les opérations de recopie des noms, puis les formules sont recréées par la suite pour revenir à la configuration initiale.

Cdlt

Dispatching NOM Prénom dans les onglets suivant Dates

Bonjour le Forum, ARTURO83

Merci pour tes explications.

Aujourd'hui, je me suis aperçu qu'en fin d'année, je vais être confronté au dispatching si la date théorique passe à Année +1 ( 2021 ). Ce qui va engendrer forcément une erreur dans le code vba actuel.
j'avais en projet, de faire la bascule mais le cas va se présenter à fortiori.

Donc je pensais à la chose suivante :
Le fichier actuel se nomme ainsi : DDSE ( 2020 ).

si la date théorique est Année +1 (la première fois), au moment de valider sur le bouton cela va effectuer une copie du fichier en cours avec comme nom cette fois : DDSE ( 2021 ) et dispatcher le NOM et Prénom dans le nouveau fichier. Là, apparaitra simplement le NOM et Prénom dans les onglets FINxx.

Seulement après, si une autre date théorique se présentait il faudrait tester si le fichier existe, l'ouvrir et faire le dispatching voulu.

j'ai commencer avec le code suivant pour la création du fichier avec Année +1 et effacer les lignes du tableau qui ne correspondaient plus à Année + 1.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Dim Chemin As String, Fichier As String, Classeur As String Dim ws As Worksheet Chemin = ThisWorkbook.Path & Application.PathSeparator Fichier = Range("D1").Value ActiveWorkbook.SaveCopyAs Chemin & Fichier Workbooks.Open Chemin & Fichier Set ws = ActiveWorkbook.Worksheets("MENU") Set ws = Nothing Dim i% For i = 500 To 8 Step -1 If Cells(i, 9).Value <> "" Then Row(i).EntireRow.Delete Next i
Merci encore
Roby

Bonne soirée à tous

Dispatching NOM Prénom dans les onglets suivant Dates

Bonjour le Forum,

Ci-dessous le code actuel du bouton Valider.

Je ne trouve pas la solution lorsque l'année de la date théorique passe à Année + 1.
Il me créé bien le fichier Année + 1, mais des erreurs subsistent encore :

Si première fois la date théorique passe à Année +1 = Ok ( fichier ok et dispatching du NOM et Prénom ok ) du fait que les feuilles Jaunes et Bleues ont été nettoyées ( vide ).

Si pour l'exemple on créé une autre personne avec les mêmes dates ( date pose et date théorique ) :
Dans le fichier Année + 1:
- Il écrase la ligne dans "MENU" ( apparait qu'une seule ligne ).
- Il n'effectue pas le code : col = col + 1 dans les feuilles bleues " Fin 00 " ( car la cellule a déjà été prise précédemment ).

Peut être que le soucis vient de l'activation du fichier Année et du fichier Année + 1 et il ne sait pas où écrire.

L'erreur fait qu'il n'arrive pas a trouver le fichier Année + 1 malgré qu'il existe dans le répertoire, testé dans la boucle.

Merci pour une piste.
Bonne fin d'après midi

Roby

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
 
Dim Mois As String
Dim Col As Long
Dim DatePose As Date, DateTheor As Date, DateFin As Date
Dim MonFichier As String
 
Private Sub ComboBox2_Change()
frmIDPPSMJ.CommandButton1.SetFocus
End Sub
 
Private Sub CommandButton1_Click() ' ***** Bouton Valider *****
'Save
'******************************************************************************************************
Dim Rep As Integer
Range("L5") = ""
' Test - Observation de fin de Peine ( Obligatoire )
If frmIDPPSMJ.TextBox5 <> "" And frmIDPPSMJ.ComboBox2 = "" Then
    Rep = MsgBox("Veuillez saisir une observation de fin de peine ( Obligatoire )", vbYes + vbExclamation, "Choix - Observation de fin de peine manquante...")
    If Rep = vbYes Then
        frmIDPPSMJ.TextBox5.SetFocus
        Exit Sub
    End If
    frmIDPPSMJ.TextBox5.SetFocus
Else
' Test - Date Théorique ( Obligatoire )
    If frmIDPPSMJ.TextBox4 = "" And frmIDPPSMJ.ComboBox1 <> "" Then
        Rep = MsgBox("Veuillez Saisir la date théorique ( Obligatoire )", vbYes + vbExclamation, "DATE - Date Théorique manquante...")
        If Rep = vbYes Then
            frmIDPPSMJ.TextBox4.SetFocus
            Exit Sub
        End If
        frmIDPPSMJ.TextBox4.SetFocus
        Exit Sub
    End If
' Test - NOM et Prénom PPSMJ = Vide
    If frmIDPPSMJ.ComboBox1.Value = "" Then
        Rep = MsgBox("Voulez-vous vraiment quitter ?", vbYesNo + vbExclamation, "Champ NOM et Prénom vide = Quitter sans prise en compte")
        If Rep = vbYes Then
            Unload frmIDPPSMJ
            Exit Sub
        Else
            frmIDPPSMJ.ComboBox1.SetFocus
            Exit Sub
        End If
    Else
' Validation - Ecriture ligne dans MENU
        Application.ScreenUpdating = False
        nom = frmIDPPSMJ.ComboBox1.Value
        Sheets("MENU").Select
        Range("Tableau1[[#Headers],[NOM et Prénom]]").Select
        Selection.End(xlDown).Select
        Selection.ListObject.ListRows.Add AlwaysInsert:=True
        ActiveCell.Offset(1, 0).Select
        ActiveCell = frmIDPPSMJ.ComboBox1.Value                                             ' NOM et Prénom
        ActiveCell.Offset(0, 1) = frmIDPPSMJ.TextBox1.Value                                 ' Numéro APPI
        ActiveCell.Offset(0, 2) = Format(frmIDPPSMJ.TextBox2.Value, "mm/dd/yyyy")           ' Date de naissance
        ActiveCell.Offset(0, 3) = Format(frmIDPPSMJ.TextBox3.Value, "mm/dd/yyyy")           ' Date pose
        ActiveCell.Offset(0, 4) = frmIDPPSMJ.Label14.Caption                                ' Durée
        DatePose = DateSerial(Year(frmIDPPSMJ.TextBox3.Value), Month(frmIDPPSMJ.TextBox3.Value), Day(frmIDPPSMJ.TextBox3.Value))
        MoisPose = Format(Month(frmIDPPSMJ.TextBox3.Value), "00")
        If TextBox5.Value <> "" Then
            ActiveCell.Offset(0, 6) = Format(frmIDPPSMJ.TextBox5.Value, "mm/dd/yyyy")       'Date réelle de fin
            DateFin = DateSerial(Year(frmIDPPSMJ.TextBox5.Value), Month(frmIDPPSMJ.TextBox5.Value), Day(frmIDPPSMJ.TextBox5.Value))
            MoisFin = Format(Month(frmIDPPSMJ.TextBox5.Value), "00")
        Else
            If TextBox4.Value <> "" Then
                ActiveCell.Offset(0, 5) = Format(frmIDPPSMJ.TextBox4.Value, "mm/dd/yyyy")   'Date théorique
                DateTheor = DateSerial(Year(frmIDPPSMJ.TextBox4.Value), Month(frmIDPPSMJ.TextBox4.Value), Day(frmIDPPSMJ.TextBox4.Value))
                MoisTheor = Format(Month(frmIDPPSMJ.TextBox4.Value), "00")
            End If
        End If
        If frmIDPPSMJ.TextBox5 <> "" Then
            If frmIDPPSMJ.ComboBox2.Value <> "" Then
                ActiveCell.Offset(0, 7) = frmIDPPSMJ.ComboBox2.Value                        ' Observation fin de peine
            End If
        End If
        TriALPHA
        StyleDD
        Unload frmIDPPSMJ
        ' Recopie dans Feuille Jaune "Pose"
        Feuille = "Pose " & MoisPose
        With Sheets(Feuille)
            .Range("C2:C32").Value = .Range("C2:C32").Value
            Set d = .Columns(3).Find(DatePose)
            Col = 4
            Do
                If .Cells(d.Row, Col) <> "" Then Col = Col + 1
            Loop While .Cells(d.Row, Col) <> ""
            .Cells(d.Row, Col) = nom
        End With
        ' On réécrit les formules du calcul des dates
        Creation_Calendrier_du_mois
        '****************************************************************************************************************
        ' Vérification de l'Année - si Année + 1 / Création du nouveau fichier
        '****************************************************************************************************************
        Dim MonFichier As String
        Dim VAn As String
        Dim Chemin As String, Classeur As String
        Dim ws As Worksheet
        Dim i%
        Chemin = ThisWorkbook.Path & Application.PathSeparator
        VAn = Range("L2").Value
        MonFichier = Range("R1").Value
        If Year(DateTheor) > VAn Then ' *********** Année + **********
            ' Vérification Fichier
            If FichierExiste(MonFichier) = True Then
                Workbooks.Open Chemin & MonFichier
                Set ws = ActiveWorkbook.Worksheets("MENU")
                Set ws = Nothing
            Else
                ' Créer le Fichier Année + 1
                ActiveWorkbook.SaveCopyAs Chemin & MonFichier
                Workbooks.Open Chemin & MonFichier
                Set ws = ActiveWorkbook.Worksheets("MENU")
                Range("L2").Value = VAn + 1
                RazJaune
                RazBleu
                ' Efface les Lignes dans MENU
                '****************************************
                For i = 8 To Range("B6") + 7
                    If Cells(i, 3).Value <> nom Then
                        Rows(i).EntireRow.Delete
                    End If
                Next i
                '****************************************
                Set ws = Nothing
            End If
            'Recopie dans Feuille bleue "Fin"
            If DateFin = 0 Then
                Feuille = "Fin " & MoisTheor
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value
                    Set d = .Columns(3).Find(DateTheor)
                    Col = 4
                    Do
                        If .Cells(d.Row, Col) <> "" Then Col = Col + 1
                    Loop While .Cells(d.Row, Col) <> ""
                    .Cells(d.Row, Col) = nom
                End With
                ' On réécrit les formules du calcul des dates
                Creation_Calendrier_du_mois
            Else
            ' Sinon on supprime la date théorique
                Feuille = "Fin " & MoisFin
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value
                    Set d = .Columns(3).Find(DateFin)
                    Col = 4
                    Do
                        If .Cells(d.Row, Col) <> "" Then Col = Col + 1
                    Loop While .Cells(d.Row, Col) <> ""
                    .Cells(d.Row, Col) = nom
                End With
                ' On réécrit les formules du calcul des dates
                Creation_Calendrier_du_mois
            End If
            StyleDD
            'Retour au fichier An - 1
            ActiveWorkbook.Save
            ActiveWorkbook.Close
            Set d = Nothing
            Set ws = Nothing
            Exit Sub
        Else
        ' *********** Année actuelle **********
            'Recopie dans Feuille bleue "Fin"
            If DateFin = 0 Then
                Feuille = "Fin " & MoisTheor
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value
                    Set d = .Columns(3).Find(DateTheor)
                    Col = 4
                    Do
                        If .Cells(d.Row, Col) <> "" Then Col = Col + 1
                    Loop While .Cells(d.Row, Col) <> ""
                    .Cells(d.Row, Col) = nom
                End With
                ' On réécrit les formules du calcul des dates
                Creation_Calendrier_du_mois
            Else
            'Sinon on supprime la date théorique
                Feuille = "Fin " & MoisFin
                With Sheets(Feuille)
                    .Range("C2:C32").Value = .Range("C2:C32").Value
                    Set d = .Columns(3).Find(DateFin)
                    Col = 4
                    Do
                        If .Cells(d.Row, Col) <> "" Then Col = Col + 1
                    Loop While .Cells(d.Row, Col) <> ""
                    .Cells(d.Row, Col) = nom
                End With
                ' On réécrit les formules du calcul des dates
                Creation_Calendrier_du_mois
            End If
            Set d = Nothing
 
        End If
    End If
End If
Call StyleDD
Call StyleDR
Range("E5") = ""
Range("G5") = ""
Range("K4") = ""
OptionButton1.Value = False
OptionButton2.Value = False
End Sub