Function DateJourSemaine(Année As Integer, mois As Byte, JourSemaine As Byte, Optional RangJourSemaine As Integer = 0, Optional DébutDuMois As Byte = 1) As Date
'Révision : ROGER2327 - 5 (Coq) Germinal CCXVII
'Modification : Magic_Doctor - 14 (Hêtre) Germinal CCXVII
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Année = année de la recherche
'Mois : janvier = 1 ---> décembre = 12
'JourSemaine : lundi = 1 ---> dimanche = 7
'RangJourSemaine = place du jour de la semaine dans le mois (ou au-delà)
'Si RangJourSemaine >= 1 ---> date d'un jour donné un certain nombre de semaines après le début choisi du mois choisi
'Si RangJourSemaine <= -1 ---> date d'un jour donné un certain nombre de semaines avant le début choisi du mois choisi
'Si RangJourSemaine = 0 on obtiendra alors (quel que soit DébutDuMois) la date où le jour de
'la semaine recherché apparaît pour la dernière fois dans le mois choisi.
'En conséquence, si RangJourSemaine <> 0, on obtiendra la date où le jour de la semaine
'recherché apparaît à la "RangJourSemaine"ème position à partir du début de mois choisi.
'Par exemple : 18ème Jeudi à partir du 1er Mars 2005 = "30/06/2005"
' 18ème Jeudi à partir du 28 Mars 2005 = "28/07/2005"
' -20ème Jeudi avant le 28 Mars 2005 = "11/11/2004"
'DébutDuMois = 1er jour du mois à partir duquel s'effectue la recherche (appartient à l'intervalle [1er du mois , dernier du mois])
'Optionnel : si omis fixe par défaut DébutDuMois au 1er du mois.
'Si > 0 effectue la recherche à partir du jour correspondant à DébutDuMois (ce jour étant inclu dans la recherche).
'Si < 0 effectue la recherche avant le jour correspondant à DébutDuMois (ce jour étant exclu de la recherche).
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Dim NbJoursDansMois As Byte
Dim DateCherchée, DerDuMois
NbJoursDansMois = Day(DateSerial(Année, mois + 1, 0))
If DébutDuMois > NbJoursDansMois Then DébutDuMois = NbJoursDansMois
DerDuMois = DateSerial(Année, mois + 1, 1) - 1 - (Weekday(DateSerial(Année, mois + 1, 1) - JourSemaine, vbMonday) - 1) Mod 7
If DébutDuMois > Day(DerDuMois) Then
DateCherchée = DateSerial(Année, mois, DébutDuMois) + 7 * IIf(RangJourSemaine < 0, RangJourSemaine + 1, RangJourSemaine) + Day(DerDuMois) - DébutDuMois
Else
DateCherchée = DerDuMois + 7 * (IIf(RangJourSemaine < 0, RangJourSemaine + 1, RangJourSemaine) - 1 - (Day(DerDuMois) - DébutDuMois) \ 7)
End If
If RangJourSemaine = 0 Then DateCherchée = DerDuMois
DateJourSemaine = DateCherchée
End Function