I’m working on a mini-calendar that is poping up when I click on a date in excel. The mini-calendar is made of userform. When I click on a date in the calendar, it transcribes it in the cell. Everything works fine. However, I would like to be able to click on the little arrows in the calendar to change the months and the years.
I have already this code written in the worksheet :
And this code in the userform coding window :
I already tried this code but in vain :
Private Sub MonthUp_Click()
’ Diminuer le mois de 1
Dim currentDate As Date
currentDate = DateSerial(UserForm1.Controls(« Année »).Caption, MonthNameToNumber(UserForm1.Controls(« Mois »).Caption), 1)
currentDate = DateAdd(« m », -1, currentDate)
UserForm1.Controls(« Mois »).Caption = VBA.monthName(Month(currentDate), True)
UserForm1.Controls(« Année »).Caption = Year(currentDate)
Feuil4.buildCalendar
End Sub
Private Sub MonthDown_Click()
’ Augmenter le mois de 1
Dim currentDate As Date
currentDate = DateSerial(UserForm1.Controls(« Année »).Caption, MonthNameToNumber(UserForm1.Controls(« Mois »).Caption), 1)
currentDate = DateAdd(« m », 1, currentDate)
UserForm1.Controls(« Mois »).Caption = VBA.monthName(Month(currentDate), True)
UserForm1.Controls(« Année »).Caption = Year(currentDate)
Feuil4.buildCalendar
End Sub
Private Sub YearUp_Click()
’ Diminuer l’année de 1
UserForm1.Controls(« Année »).Caption = UserForm1.Controls(« Année »).Caption - 1
Feuil4.buildCalendar
End Sub
Private Sub YearDown_Click()
’ Augmenter l’année de 1
UserForm1.Controls(« Année »).Caption = UserForm1.Controls(« Année »).Caption + 1
Feuil4.buildCalendar
End Sub
Function MonthNameToNumber(monthName As String) As Integer
’ Convertir le nom du mois en numéro de mois
Dim i As Integer
For i = 1 To 12
If VBA.monthName(i, False) = monthName Then
MonthNameToNumber = i
Exit Function
End If
Next i
End Function
2
Finally, it works with this code in the userform coding area:
Private Sub IblDown_Click()
Dim strd As String
Dim iMonth, iYear, iStartofMonthDay As Integer
Dim startOfMonth, trackingDate As Date
Dim cDay As control
strd = Mois.Caption
Mois.Caption = Format(DateAdd("m", -1, CDate(strd)), "mmmm yyyy")
iYear = Year(DateAdd("m", -1, CDate(strd)))
iMonth = Month(DateAdd("m", -1, CDate(strd)))
startOfMonth = DateSerial(iYear, iMonth, 1)
iStartofMonthDay = Weekday(startOfMonth, vbMonday)
trackingDate = DateAdd("d", -iStartofMonthDay + 1, startOfMonth)
For i = 1 To 30
' Skip weekends
While Weekday(trackingDate) = 7 Or Weekday(trackingDate) = 1 ' If it's Saturday or Sunday
trackingDate = DateAdd("d", 1, trackingDate) ' Skip to next day
Wend
Set cDay = MiniCalendrier.Controls("Jour" & i)
cDay.Caption = Day(trackingDate)
cDay.Tag = trackingDate
' Check if the month of the trackingDate is different from the current month
If Month(trackingDate) <> iMonth Then
cDay.ForeColor = 8421504 ' Change the color to gray
Else
cDay.ForeColor = 0 ' Change the color to black
End If
trackingDate = DateAdd("d", 1, trackingDate)
Next
End Sub
Private Sub IblUp_Click()
Dim strd As String
Dim iMonth, iYear, iStartofMonthDay As Integer
Dim startOfMonth, trackingDate As Date
Dim cDay As control
strd = Mois.Caption
Mois.Caption = Format(DateAdd("m", 1, CDate(strd)), "mmmm yyyy")
iYear = Year(DateAdd("m", 1, CDate(strd)))
iMonth = Month(DateAdd("m", 1, CDate(strd)))
startOfMonth = DateSerial(iYear, iMonth, 1)
iStartofMonthDay = Weekday(startOfMonth, vbMonday)
trackingDate = DateAdd("d", -iStartofMonthDay + 1, startOfMonth)
For i = 1 To 30
' Skip weekends
While Weekday(trackingDate) = 7 Or Weekday(trackingDate) = 1 ' If it's Saturday or Sunday
trackingDate = DateAdd("d", 1, trackingDate) ' Skip to next day
Wend
Set cDay = MiniCalendrier.Controls("Jour" & i)
cDay.Caption = Day(trackingDate)
cDay.Tag = trackingDate
' Check if the month of the trackingDate is different from the current month
If Month(trackingDate) <> iMonth Then
cDay.ForeColor = 8421504 ' Change the color to gray
Else
cDay.ForeColor = 0 ' Change the color to black
End If
trackingDate = DateAdd("d", 1, trackingDate)
Next
End Sub