Private Sub Workbook_Open()
Dim wSheet As Worksheet
Dim Feuille As String, AMasquer As String
Dim I As Integer
Application.ScreenUpdating = False
For Each wSheet In Worksheets
wSheet.Protect UserInterfaceOnly:=True
Next wSheet
Feuille = MonthName(Month(Date)) & " " & Year(Date)
If FeuilleExiste(Feuille) = False Then Exit Sub
If UCase(Feuille) <> UCase(ActiveSheet.Name) Then
' Teste le nom en majuscule de la feuille du mois en cours avec le nom en majuscule de la feuille affichée
AMasquer = ActiveSheet.Name
With Sheets(Feuille)
.Visible = True
.Select
End With
Sheets(AMasquer).Visible = xlSheetVeryHidden
End If
For I = 1 To Sheets.Count
If UCase(Sheets(I).Name) <> UCase(Feuille) Then Sheets(I).Visible = xlSheetVeryHidden
Next I
Colorise_Le_Mois Day(DateAdd("m", 1, DateValue(ActiveSheet.Name)) - 1)
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour&, Ladate As Date, MoisSuivant$
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
' On recherche si la page est surveillée
If IsDate("1/" & Sh.Name) Then 'plus simple non ???
' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
If Target.Row - 5 > Day(Date) Then
Beep
MsgBox "PAS LE BON JOUR"
Target = ""
Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).Interior.ColorIndex = 8
Else
' Surveille la plage du 1er au dernier jours du mois
If Not Intersect(Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then
' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
Ladate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
' Si la colonne B et la colonne C est vide on efface la date
Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)
If Range("A" & Target.Row) = "" Then Cells(Target.Row, 1).Resize(, 7).Interior.ColorIndex = 8
' si la ligne modifiée est la dernière du mois et que la colonne est la C
If Target.Row = NombreJour + 5 And Target.Column = 3 Then
' On construit le nom de la feuille du mois suivant
MoisSuivant = MonthName(Month(DateAdd("m", 1, DateValue(Sh.Name)))) & " " & Year(DateAdd("m", 1, DateValue(Sh.Name)))
' On va vérifier si la feuille existe
If FeuilleExiste(MoisSuivant) = False Then Exit Sub
' La feuille existe
With Sheets(MoisSuivant)
'On la rend visible
.Visible = xlSheetVisible
' On masque celle que l'on vient de finir
ActiveSheet.Visible = xlSheetHidden
' et on la sélectionne
.Select
End With
End If
End If
If Range("A" & Target.Row) <> "" Then
Colorise_Le_Mois NombreJour
End If
End If
End If
Application.EnableEvents = True
End Sub
Sub Colorise_Le_Mois(NombreJour)
Dim Cel As Range, Plage As Range, F As String, J As Integer, I As Integer
Application.ScreenUpdating = False
Set Plage = Range(Cells(6, 1), Cells(5 + NombreJour, 1)).Resize(, 7) 'Mettre 5 dans ligne macro => Cells(5 + NombreJour, 1)).Resize(, 7) au lieu de 6 pour ne pas afficher ligne 27 les mois de 31 jours
'mémorise le formatage de la colonne A puis passe la colonne A au format "Standard" pour avoir des valeurs de type Long
'F = Plage.Columns(1).NumberFormat 'Si cette ligne de macro ne fonctionne pas appliquer la ligne ci-dessous
If IsNull(Plage.Columns(1).NumberFormat) Then F = "dddd dd mmmm yyyy" Else F = Plage.Columns(1).NumberFormat
Plage.Columns(1).NumberFormat = "General"
'effectue la recherche de la date en type Long sur la colonne A
Set Cel = Plage.Columns(1).Find(CLng(Date), , xlValues, xlWhole)
'puis rétabli le format
Plage.Columns(1).NumberFormat = F
Plage.Interior.ColorIndex = 8
'si trouvée, mets la plage au fond 8 puis colore la ligne du jour
If Not Cel Is Nothing Then
Range(Cells(Cel.Row, 1), Cells(Cel.Row, Plage.Columns.Count)).Interior.ColorIndex = 17
J = Cel.Row - 1
End If
If J = 0 Then J = Plage.Rows.Count + 6
'colore ensuite les cellules en fonction du jour
For I = 6 To J
If Cells(I, 1).Value <> "" Then
If Application.CountIf(Sheets("Menu").Range("JOursFériés"), Range("A" & I)) > 0 Or Weekday(Range("A" & I), vbMonday) > 5 Then
Range("A" & I & ":G" & I).Interior.ColorIndex = 38
Else
Range("A" & I).Interior.ColorIndex = 15
Range("B" & I).Interior.ColorIndex = 6
Range("C" & I).Interior.ColorIndex = 4
Range("D" & I & ":G" & I).Interior.ColorIndex = 43
End If
End If
Next I
Application.ScreenUpdating = True
Call DerniereLigne
End Sub
