Episode V de la saga ‘Weekday’. Cette fois-ci, on introduit la notion de semaine puisque l’on souhaite obtenir la date d’un jour quelconque de la semaine de la date de référence. Quelle est la date du dimanche de cette semaine ? La date du mardi ?
Préambule
Je vous conseille de lire le premier billet de ‘Weekday’ pour comprendre le principe des calculs.
Voir aussi le récapitulatif des fonctions.
Les matrices
On souhaite donc passer de la matrice ‘Weekday’ à la matrice ‘Jour de la semaine courante’. Si le premier jour de semaine est un lundi (qui peut être le dimanche comme aux U.S.A.), la matrice finale est :
VbDayOfWeek VbDayOfWeek
Jour Date L M M J V S D Jour date L M M J V S D
Lundi 1 7 6 5 4 3 2 Lundi 0 1 2 3 4 5 6
Mardi 2 1 7 6 5 4 3 Mardi -1 0 1 2 3 4 5
Mercredi 3 2 1 7 6 5 4 vers Mercredi -2 -1 0 1 2 3 4
Jeudi 4 3 2 1 7 6 5 Jeudi -3 -2 -1 0 1 2 3
Vendredi 5 4 3 2 1 7 6 Vendredi -4 -3 -2 -1 0 1 2
Samedi 6 5 4 3 2 1 7 Samedi -5 -4 -3 -2 -1 0 1
Dimanche 7 6 5 4 3 2 1 Dimanche -6 -5 -4 -3 -2 -1 0
On remarque que les valeurs sont symétriquement opposées par rapport à la diagonale. Pour pouvoir gérer tous les cas quelque soit le premier jour de semaine, le plus simple est de se servir de ce premier jour de semaine comme pivot.
La fonction VBA
Optional ByVal PremierJourDeSemaine As VbDayOfWeek = vbMonday) As Date
DateJourSemaineEnCours = DateRef + (Jour - CInt(Weekday(DateRef, PremierJourDeSemaine)) - PremierJourDeSemaine + 1)
If Jour < PremierJourDeSemaine Then DateJourSemaineEnCours = DateJourSemaineEnCours + 7
End Function
La fonction admet trois paramètres : La date de référence et le jour de semaine recherché. Le troisième paramètre est optionnel (PremierJourDeSemaine) et contient sous forme de constante le nom du 1er jour de semaine. La valeur par défaut de ce paramètre est lundi.
Tester la fonction
La fonction suivante teste les 49 x 7 possibilités des matrices et affiche les résultats dans la fenêtre ‘Exécution’ de l’éditeur VB.
Dim s As String, d As Date, dates(1 To 7) As Date
Dim i As Integer, j As Integer, k As Integer, l As Integer, NbErr As Integer, SumErr As Integer
d = Int(Now())
Debug.Print "Test DateJourSemaineEnCours()" & vbCrLf & "----------------------"
For l = 1 To 7
d = Int(Now())
While Weekday(d) <> l: d = d + 1: Wend
For k = 0 To 6: dates(Weekday(d + k)) = d + k: Next k
Debug.Print "* Semaine du " & Format(d, "dddd dd/mm/yyyy") & " au " & Format(d + 6, "dddd dd/mm/yyyy")
For i = 1 To 7
NbErr = 0
s = vbTab & "-> Jour recherché : " & Format(d + i - 1, "ddd dd/mm/yyyy") & " : "
For j = 0 To 6
If DateJourSemaineEnCours(d + j, i, l) <> dates(i) Then NbErr = NbErr + 1
Next j
Debug.Print s & IIf(NbErr > 0, NbErr, " Aucune") & " erreur(s)"
SumErr = SumErr + NbErr
Next
Next l
Debug.Print "***" & IIf(SumErr > 0, SumErr, " Aucune") & " erreur(s) commise(s) ***"
End Function
Exemples
A coller dans la fenêtre ‘Exécution’ du VBE.
?DateJourSemaineEnCours(#2012/11/8#,vbSunday) '11/11/2012
'Date du lundi pour la date donnée et pour une semaine commençant le lundi
?DateJourSemaineEnCours(#2012/11/8#,vbMonday) '05/11/2012
'Date du dimanche pour la date donnée et pour une semaine commençant le dimanche
?DateJourSemaineEnCours(#2012/11/8#,vbSunday,vbSunday) '04/11/2012
@+ pour la suite des épisodes ‘Weekday’.
Philippe