Sub Annee()
Dim BE As Variant 'déclare la variable BE (Boîte d'Entrée)
Dim O As Worksheet 'déclare la variable 0 (Onglet)
Dim PJ As String 'déclare la variable PJ (Premier Jour)
Dim DD As Date 'déclare la variable DD (Date Début)
Dim OA As Worksheet 'déclare la variable OA (Onglet Année)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim DP1 As Date 'déclare la variable DP1 (Date plus 1 jour)
Dim JS As String 'déclare la variable JS (Jour Suivant)
Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Application.Calculation = xlCalculationManual 'mode se calcul manuel
BE = Application.InputBox("Taper l'année au format AAAA;", "Année", Year(Date), Type:=1) 'definit la boîte d'entrée BE
If BE = False Then Exit Sub 'si bouton [Annuler], sort de la procédure
For Each O In Sheets 'boucle sur tous les onglets O du classeur
If O.Name = CStr(BE) Then 'condition 1 : si l'onglet de la boucle se nomme BE (convertie en texte)
'condition 2 : si "Oui" au message
If MsgBox("Un onglet " & BE & " existe déjà. Voulez-vous le supprimer et en créer un nouveau ?", vbYesNo, "Attention") = vbYes Then
Application.DisplayAlerts = False ' empêche les messages d'Excel
Worksheets(CStr(BE)).Delete 'supprime l'onglet
Application.DisplayAlerts = True 'autorise les messages d'Excel
Exit For ' sort de la boucle
Else 'sinon ("Non" au message)
Worksheets(CStr(BE)).Activate 'active l'onglet
Exit Sub 'sort de la procédure
End If 'fin de la condition 2
End If 'fin de la condition 1
Next O 'prochain onglet de la boucle
'définit le premier jour de l'annéé PJ
PJ = Choose(Weekday(DateSerial(BE, 1, 1), vbMonday), "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
Select Case PJ 'agit en fonction du premier jour PJ
Case "Samedi" 'cas Samedi
DD = DateSerial(BE, 1, 3) 'définit la date de début DD (toisième jour de l'annéé) pour sauter le week-end
Case "Dimanche" 'cas Samedi
DD = DateSerial(BE, 1, 2) 'définit la date de début DD (deuxième jour de l'annéé) pour sauter le week-end
Case Else 'tous les autres cas
DD = DateSerial(BE, 1, 1) 'définit la date de début DD (premier jour de l'annéé)
End Select 'fin de l'action en fonction du premier jour PJ
Me.Copy After:=Me 'copie longlet "Modèle" après lui-même
ActiveSheet.Name = BE 'renomme l'onglet actif
Set OA = ActiveSheet 'définit l'onglet année OA
OA.Range("C2").Value = OA.Range("C2").Value & BE 'modifie le titre en C2
'renvoie le jour de la semaine de la date de début DD dans A9
OA.Range("A9").Value = Choose(Weekday(DD, vbMonday), "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi")
OA.Range("A10").Value = DD 'renvoie la date de début DD dans A10
For I = 1 To 365 'boucle sur 365 jours
DP1 = IIf(DP1 = "00:00:00", DD + 1, DP1 + 1) 'définit la date plus 1 jour DP1
JS = Choose(Weekday(DP1, vbMonday), "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche") 'Définit le jour suivant JS
Select Case JS 'agit en fonction du jour suivant JS
Case "Samedi" 'cas Samedi
DP1 = DP1 + 2 'redéfinit la date plus 1 jour en rajoutant 2 jours pour sauter le week-end
Case "Dimanche" 'cas Samedi
DP1 = DP1 + 1 'redéfinit la date plus 1 jour en rajoutant 1 jour pour sauter le week-end
End Select 'fin de l'action en fonction du jour suivant JS
If Year(DP1) <> BE Then Exit For 'si l'année de DP1 est différente de BE, sort de la boucle
Set DEST = OA.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
OA.Range("A9:L22").Copy DEST 'copie la plage A9:A22 et la colle dans DEST
DEST.Value = Choose(Weekday(DP1, vbMonday), "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi") 'renvoie le jour de la semaine dans DEST
DEST.Offset(1, 0).Value = DP1 'renvoie la date plus 1 jour dans DEST décalée d'une cellule vers le bas
Next I 'prochein jour de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
End Sub
