Public M As Integer

Public Sub AffichageDate(MyJour, K As Integer)
    'Affichage des jours
    Dim L As Variant
    
    L = Format(K, "0#")
    Select Case MyJour
    Case 1
        Mois(M).Text = Mois(M).Text & L & " Dim" & vbCrLf
    Case 2
        Mois(M).Text = Mois(M).Text & L & " Lun" & vbCrLf
    Case 3
        Mois(M).Text = Mois(M).Text & L & " Mar" & vbCrLf
    Case 4
        Mois(M).Text = Mois(M).Text & L & " Mer" & vbCrLf
    Case 5
        Mois(M).Text = Mois(M).Text & L & " Jeu" & vbCrLf
    Case 6
        Mois(M).Text = Mois(M).Text & L & " Ven" & vbCrLf
    Case 7
        Mois(M).Text = Mois(M).Text & L & " Sam" & vbCrLf
    End Select
    Mois(M).SelLength = Len(Mois(M).Text)
    Mois(M).SelColor = vbBlack
End Sub

Public Sub MiseAJour()
    'Mise à jour du calendrier selon les années sélectionnées
    Dim MyDate, MyJour
    'K => Compteur de jours, I => Compteur, X
    Dim K As Integer, I As Integer, X As Integer
    
    Screen.MousePointer = 11
    'On efface le calendrier
    For I = 0 To 11
        Mois(I).Text = ""
    Next I
    'Premier jour du calendrier
    MyDate = "1 8 " & Left(Année.Caption, 4)
    K = 1
    M = 0
    'On vérifie s'il s'agit d'une année bisextile
    If Right(Année.Caption, 4) Mod 4 = 0 Then
        'Si oui
        X = 1
        J = 366
    Else
        'Si non
        X = 0
        J = 365
    End If
    'on remplit les mois
    For I = 1 To J
        MyJour = Weekday(MyDate)
        Call AffichageDate(MyJour, K)
        K = K + 1
        MyDate = CDate(MyDate) + 1
        'On vérifie si on est à la fin du mois
        If Test(I, X) = 1 Then K = 1
    Next I
    'on affiche les dimanches en bleu
    For I = 0 To 11
        For J = 1 To Len(Mois(I).Text) Step 8
            If Mid(Mois(I).Text, J + 3, 1) = "D" Then
                Mois(I).SelStart = J - 1
                Mois(I).SelLength = 8
                Mois(I).SelColor = RGB(0, 0, 255)
                Mois(I).SelLength = 0
                Mois(I).SelColor = RGB(0, 0, 0)
            End If
        Next J
    Next I
    Screen.MousePointer = 1
End Sub

Public Function Test(I As Integer, X As Integer) As Integer
    'Test des fin de mois
    'Si année non bisextile
    If X = 0 Then
        Select Case I
        Case 31
            M = 1
            Test = 1
        Case 61
            M = 2
            Test = 1
        Case 92
            M = 3
            Test = 1
        Case 122
            M = 4
            Test = 1
        Case 153
            M = 5
            Test = 1
        Case 184
            M = 6
            Test = 1
        Case 212
            M = 7
            Test = 1
        Case 243
            M = 8
            Test = 1
        Case 273
            M = 9
            Test = 1
        Case 304
            M = 10
            Test = 1
        Case 334
            M = 11
            Test = 1
        End Select
    Else
        'Si année bixetile
        Select Case I
        Case 31
            M = 1
            Test = 1
        Case 61
            M = 2
            Test = 1
        Case 92
            M = 3
            Test = 1
        Case 122
            M = 4
            Test = 1
        Case 153
            M = 5
            Test = 1
        Case 184
            M = 6
            Test = 1
        Case 213
            M = 7
            Test = 1
        Case 244
            M = 8
            Test = 1
        Case 274
            M = 9
            Test = 1
        Case 305
            M = 10
            Test = 1
        Case 335
            M = 11
            Test = 1
        End Select
    End If
End Function

Private Sub Form_Load()
    Call MiseAJour
End Sub

Private Sub Mois_Click(Index As Integer)
    'Renvoi le jour sur lequel on a cliqué
    Dim Clic As Integer, I As Integer
    Dim Erreur As Long
    Dim VCod As Integer
    
    Clic = Mois(Index).SelStart
    I = Clic
    Mois(Index).SelLength = 1
    On Error Resume Next
    VCod = Asc(Mois(Index).SelText)
    Erreur = Err
    On Error GoTo 0
    Do While Erreur = 0
        I = I - 1
        Mois(Index).SelStart = I
        Mois(Index).SelLength = 1
        On Error Resume Next
        VCod = Asc(Mois(Index).SelText)
        Erreur = Err
        On Error GoTo 0
    Loop
    Mois(Index).SelStart = I + 1
    Mois(Index).SelLength = 6
    If Mois(Index).Tag > 7 And Mois(Index).Tag < 13 Then
        VTexte = Left(Mois(Index).SelText, 2) & "/" & Mois(Index).Tag & "/" &  _
            Left(Année.Caption, 4)
    Else
        VTexte = Left(Mois(Index).SelText, 2) & "/" & Mois(Index).Tag & "/" &  _
            Right(Année.Caption, 4)
    End If
    MsgBox "Vous avez cliqué sur le : " & Format(VTexte, "dddd d mmmm yyyy")
    Mois(Index).SelLength = 0
End Sub

Private Sub UpDown_Click(Index As Integer)
    'Change d'année
    Dim VTexte As String
    
    VTexte = Année.Caption
    If Index = 0 Then
        If Left(VTexte, 4) > 1900 Then Année.Caption = Left(VTexte, 4) - 1 & " \" & _
            " " & Right(VTexte, 4) - 1
    Else
        If Left(VTexte, 4) < 2100 Then Année.Caption = Left(VTexte, 4) + 1 & " \" & _
            " " & Right(VTexte, 4) + 1
    End If
    MiseAJour
End Sub