Bonjour à tous,
Me voici revenu sur le forum car j'ai eu de bons retour. J'ai réussi avec votre aide à modifier presque tout ce que je voulais mais ce pose un nouveau problème car ce programme est fait SANS MFC.
Donc je veux ajouter les 6 lignes suivantes pour que les couleurs apparaissent dans les nouvelles feuilles. (Ajout d'une feuilles après Décembre2014) en cliquant sur le bouton Nouveau Mois.
Ci-dessous les 6 lignes à "caser" dans le ThisWorbook
Puis encore dessous le ThisWorbook en entier.

Merci pour vos éventuels retours.
Cordialement
AL

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
Range("A" & Target.Row).Interior.ColorIndex = 15
Range("B" & Target.Row).Interior.ColorIndex = 6
Range("C" & Target.Row).Interior.ColorIndex = 4
Range("D" & Target.Row).Interior.ColorIndex = 43
Range("E" & Target.Row).Interior.ColorIndex = 43
Range("F" & Target.Row).Interior.ColorIndex = 43
 
 
Private Sub Workbook_Open()
Dim wSheet As Worksheet
Dim Feuille As String, AMasquer As String
Dim I As Integer
 
  For Each wSheet In Worksheets
    wSheet.Protect UserInterfaceOnly:=True
  Next wSheet
 
  Feuille = MonthName(Month(Date)) & Year(Date)
  If FeuilleExiste(Feuille) = False Then Exit Sub
 
  Application.ScreenUpdating = False
 
  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
 
  If Time > TimeSerial(12, 0, 0) Then
    Sheets(Feuille).Range("C" & 5 + Day(Date)) = 5
  Else
    Sheets(Feuille).Range("B" & 5 + Day(Date)) = 5
  End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date
Dim MoisSuivant As String
Dim LeMois As String
 
  If Val(Right(Sh.Name, 4)) = 0 Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  ' On recherche si la page est surveillée
  LeMois = Left(Sh.Name, Len(Sh.Name) - 4)
  'If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
              Split(Sh.Name, " ")(0), vbTextCompare) Then
  If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
              LeMois, vbTextCompare) Then
    ' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
    'NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
    NombreJour = Day(DateAdd("m", 1, DateValue("1/" & LeMois)) - 1)
    If Target.Row - 5 > Day(Date) Then
      Beep
      MsgBox "PAS LE BON JOUR"
      Target = ""
    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)
        Ladate = DateSerial(Right(Sh.Name, 4), Month(DateValue("1/" & LeMois)), 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)
        ' 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("1/" & LeMois)))) & " " & Year(DateAdd("m", 1, DateValue("1/" & LeMois)))
          ' 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
    End If
  End If
  Application.EnableEvents = True
End Sub
 
 
Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function