Re : Déterminer la date du premier lundi de septembre
Bonjour Aloha
Voici une fonction que j'avais concoctée pour des besoins personnels et qui, peut-être, résoudra ton problème.
Function DateJourSemaine(Année, Mois, JourSemaine, RangJourSemaine, AuDelaMois) As String
'Fonction grabada el 27/06/2005 por Magic_Doctor
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Année = année de la recherche
'Mois = mois de la recherche
'JourSemaine = le jour de la semaine que l'on recherche :
'Dimanche=1 / Lundi=2 / Mardi=3 / Mercredi=4 / Jeudi=5 / Vendredi=6 / Samedi=7
'RangJourSemaine = place du jour de la semaine dans le mois (ou au-delà)
'(par exemple : 3ème Lundi (=2) de Septembre 2005 = "15/09/2005").
'AuDelaMois = possibilité de trouver une date au-delà du Mois.
'Si AuDelaMois=0 et si RangJourSemaine dépasse le Mois, alors on obtiendra la date
'où le jour de la semaine recherché apparaît pour la dernière fois dans le Mois
'(par exemple : dernier Dimanche d'Août 2005 = "28/08/2005").
'Si AuDelaMois=1 et si RangJourSemaine dépasse le Mois, alors on obtiendra la date
'où le jour de la semaine recherché apparaît à la "RangJourSemaine"ème position après
'le début de Mois (par exemple : 18ème Jeudi après le 1er Mars 2005 = "30/06/2005").
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Dim DateDébutMois, j1, j2, r1, r2, DateCherchée, i As Byte
DateDébutMois = CDate("1/" & Mois & "/" & Année)
j1 = Weekday(DateDébutMois)
If j1 >= JourSemaine Then
j2 = JourSemaine
Else
j2 = 0
End If
If j1 < JourSemaine Then
r1 = 7 - JourSemaine
Else
r1 = 0
End If
If j1 = JourSemaine Then
r2 = Abs(7 - 7 * RangJourSemaine)
Else
r2 = 7 * RangJourSemaine
End If
DateCherchée = DateDébutMois + j2 - j1 - r1 + r2
If AuDelaMois = 0 Then
If Month(DateCherchée) > Month(DateDébutMois) Then
Do
For i = 1 To 6
If j1 = JourSemaine Then
r2 = Abs(7 - 7 * i)
Else
r2 = 7 * i
End If
DateCherchée = DateDébutMois + j2 - j1 - r1 + r2
Next i
Loop Until Month(DateCherchée) > Month(DateDébutMois)
DateCherchée = DateCherchée - 14
End If
End If
DateJourSemaine = DateCherchée
End Function