Petit calendrier à partir d'userform

Bonjour,

J’ai un fichier excel dans lequel j’ai un code qui permet de faire apparaitre un calendrier si la case est une date, si elle est en dessous d’une date, etc. À partir du petit calendrier on peut choisir une date, c’est sa fonction initiale et elle va s’inscrire dans la cellule.

  1. Or, j’aimerais à partir des flèches que j’ai mis vers le haut et vers le bas pouvoir changer les mois et les années dans le calendrier.
  2. J’ai aussi deux autres userform pour choisir manuellement les mois et années que j’aimerais connecté au petit calendrier. En cliquant directement sur le mois et sur l’année de ce petit calendrier, on aurait les options.

Voici, le document :
Calendrier.xlsm (47,5 Ko)

Le code suivant qui est présent dans l’userform est un essai que j’ai fait sans succès :

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

Finalement, j’ai réussi avec ce code :

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

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.