DONNÉES DU CALENDRIER

'                                                  1 2 3 4 5 6 7   1 ............12
Dim TbFrequenceJour(1 To 7, 1 To 12) As Integer ' (l,m,m,j,v,s,d / janvier,..., decembre)
Dim TbFrequenceJourPAIR(1 To 7, 1 To 12) As Integer ' (l,m,m,j,v,s,d / janvier,..., decembre)
Dim TbFrequenceJourIMPAIR(1 To 7, 1 To 12) As Integer ' (l,m,m,j,v,s,d / janvier,..., decembre)
Private Sub Command2_Click()

    Dim ChronoDebut As Date
    Dim ChronoFin As Date
    Dim DateDebut As Date
    Dim MaDate As Date
    Dim NbJours As Integer
    Dim TempText As String
    Dim Jour As String
    Dim Mois As String
    Dim Pair As Boolean
    Dim Colonne As Integer

DateDebut = CDate("01/01/2005")
NbJours = 365
'compter le nombre de lundi, mardi, mercr... dans chaque mois.
'initilisation du tableau
For i = 1 To 7
    For j = 1 To 12
    TbFrequenceJour(i, j) = 0
    TbFrequenceJourPAIR(i, j) = 0
    TbFrequenceJourIMPAIR(i, j) = 0
    Next j
Next i

MaDate = DateDebut
While MaDate < CDate("31/12/2005")
    
    TempText = Format(MaDate, "dddd d mmmm yyyy", vbUseSystemDayOfWeek, vbUseSystem)
    'recupère le jour de la semaine par les deux premieres lettres
    Jour = Left(TempText, 2)
    'recupère le jour pair ou impair
    If Int(Left(MaDate, 2) / 2 * 10) = 5 Then Pair = False Else Pair = True
    'recupère le mois
    Mois = CInt(Mid(MaDate, InStr(MaDate, "/") + 1, 2))
    'remplit le tableau
    'compte les frequence en jours
    TbFrequenceJour(FctNumJour(Jour), Mois) = TbFrequenceJour(FctNumJour(Jour), Mois) + 1
    
    'compte les frequences paires/impaires
    Select Case Pair
    Case True
    TbFrequenceJourPAIR(FctNumJour(Jour), Mois) = TbFrequenceJourPAIR(FctNumJour(Jour), Mois) + 1
    Case False
    TbFrequenceJourIMPAIR(FctNumJour(Jour), Mois) = TbFrequenceJourIMPAIR(FctNumJour(Jour), Mois) + 1
    End Select
    
    MaDate = MaDate + 1
    DoEvents
Wend
Debug.Print DateDebut + 31
End Sub
Private Function FctNumJour(DeuxLettresJour As String) As Integer
Select Case DeuxLettresJour
    Case "lu"
        FctNumJour = 1
    Case "ma"
        FctNumJour = 2
    Case "me"
        FctNumJour = 3
    Case "je"
        FctNumJour = 4
    Case "ve"
        FctNumJour = 5
    Case "sa"
        FctNumJour = 6
    Case "di"
        FctNumJour = 7
    Case Else
        FctNumJour = 0
End Select
End Function