Code VBA à modifier pour voir colonne A
Bonjour le forum,
Dans ThisWorkbook j’ai le code ci-dessous.
Code:
1
2
3
4
5
6
| Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
Split(Sh.Name, " ")(0), vbTextCompare) Then
Application.Goto Sh.[B6], True '[B6] à la place de [A1] pour faire passer le mois suivant sur cellule B6
End If
End Sub |
Lorsque j’arrive à la fin du mois je fait supp dans cellule C30 ou C31 et ça passe au mois suivant dans cellule A1.
Si je mets B6 à la place de A1 ça passe bien mais je ne vois pas la colonne A.
Je joints également le reste du code.
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
| 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
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
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
' On recherche si la page est surveillée
If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
Split(Sh.Name, " ")(0), 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)
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)
' 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(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
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
ThisWorkbook.VBProject.References _
.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 0
End Sub
Function FeuilleExiste(Nom As String) As Boolean
On Error Resume Next
FeuilleExiste = Sheets(Nom).Name <> ""
On Error GoTo 0
End Function
Sub ret()
Application.EnableEvents = True
End Sub |
Quelqu'un aurait-il une explication?
Merci pour vos éventuelles réponses.
Bonne journée à vous tous
Bien cordialement
