Où mettre ces 5 lignes dans le ThisWorbook?

**Un Internaute** · 28/04/2014, 06h53

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

**Philippe Tulliez** · 28/04/2014, 07h36

Bonjour,

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.

Je ne comprends pas ta dernière phrase.
Les six lignes que tu affiches

Code :

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

1
2
3
4
5
6
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

vont modifier les cellules de la feuille active donc si tu as un bouton qui invoque une procédure qui ajoute une feuille et que tu veux absolument placer ces six lignes de code dans ThisWorkbook, je ne vois pas d'autres options que les placer dans la procédure événementielle Workbook_NewSheet.
Exemple

Code :

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

1
2
3
Private Sub Workbook_NewSheet(ByVal Sh As Object)
  MsgBox "Une nouvelle feuille nommée " & Sh.Name & " vient d'être insérée"
End Sub

La procédure événementielle Workbook_SheetActivate pourrait également être utilisée puisqu'une feuille insérée devient active mais il faudrait faire un test pour vérifier si la feuille activée est bien la dernière insérée et de plus vérifier si les propriétés Interior.ColorIndex n'ont pas déjà été modifiées.

**Un Internaute** · 28/04/2014, 07h58

Oui c'est exactement ça. Dans la nouvelle feuille Janvier2014 par exemple les couleurs vont s'appliquer aux jours => jours fériés, samedi et dimanche.
Le problème c'est que moi je ne sais pas faire. Si ça te dit avec le fichier!
Bien cordialement

Où mettre ces 5 lignes dans le ThisWorbook?

Macros et VBA Excel

Discussions similaires

Partager

Partager