Données du calendrier

Commenter

Contenu du snippet

Cette source remplit trois tableaux pour compter :
-le nb de jours par mois (nb de lundi, de mardi etc)
-le nombre de jours pairs (nb de lundi pairs, mardi pairs ...etc)
-le nombre de jours impairs (nb de lundi pairs, mardi pairs ...etc)

Source / Exemple : 


'                                                  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

Conclusion :


merci à vbfrance et à toutes ces sources, bravo à tous.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (DJALEMBA)