il y avait longtemps que je ne mettais mis à programmer pour le plaisir faute d'inspiration,
mon sujet préféré étant le temps qui passe, c'est sûrement lié à l'âge, j'ai donc conçu un petit programme qui calcule le premier jour ouvré de chaque semaine de chaque mois:
Code : Tout sélectionner
;Jours ouvrés
;il faut que chaque semaine commence un lundi, sauf si le jour est férié
EnableExplicit
Global i
Procedure.l Paques_(annee.l) ; interne
Protected a, b, c, d, e, f, g, h, i, k, l, m, Resultat
a = Mod(annee, 19)
b = annee / 100
c = Mod(annee, 100)
d = b / 4
e = Mod(b, 4)
f = (b + 8) / 25
g = (b - f + 1) / 3
h = Mod((19 * a + b - d - g + 15), 30)
i = c / 4
k = Mod(c, 4)
l = Mod((32 + 2 * e + 2 * i - h - k), 7)
m = (a + 11 * h + 22 * l) / 451
Resultat = 22 + h + l - 7 * m
ProcedureReturn Resultat
EndProcedure
Procedure.l Paques(annee.l = -1)
Protected jour, mois = 3
If annee = -1
annee = Year(Date())
EndIf
jour = Paques_(annee)
If jour
If jour > 31
jour - 31
mois + 1
EndIf
ProcedureReturn Date(annee, mois, jour, 0, 0, 0)
EndIf
EndProcedure
Procedure.l PaquesLundi(annee.l = -1)
ProcedureReturn AddDate(Paques(annee), #PB_Date_Day , 1)
EndProcedure
Procedure.l PentecoteLundi(annee.l = -1)
ProcedureReturn AddDate(Paques(annee), #PB_Date_Day , 50)
EndProcedure
Procedure$ NomJours(Date)
Protected Jour$ = StringField("Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi", DayOfWeek(Date)%7 + 1, " ")
ProcedureReturn Jour$
EndProcedure
Procedure Bissextile(Annee)
If Annee <= 0
Annee = Year(Date())
EndIf ;Cetteannée
If(Mod(Annee, 4) = 0 And Mod(Annee, 100) <> 0) Or (Mod(Annee, 400) = 0)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure JoursDansMois(Annee,Mois)
Protected Jours, NbjoursMois
If Annee = -1
Annee=Year(Date())
If Mois = -1
Mois=Month(Date())
EndIf
Else
If Mois <= 0 : Mois = 2 : EndIf
EndIf
If Mois=2
If Bissextile(Annee)
Jours=29
Else
Jours=28
EndIf
Else
jours=31 - $A55 >> Mois & 1
EndIf
NbjoursMois=Jours
ProcedureReturn NbjoursMois
EndProcedure
Procedure.s JourOuvrable1(Annee,Mois)
Protected Jour=1, Joursem = 5 ;le premier jour ouvré tombe un samedi 1 ?
Protected DatePremierJourOuvre=Date(Annee,Mois,Jour,0,0,0)
;Chercher le premier samedi
While DayOfWeek(DatePremierJourOuvre)<>Joursem
Jour+1
DatePremierJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Wend
;remonter la semaine jusqu'au premier lundi du mois, si le 1 n'est pas atteint
If Jour = 1
DatePremierJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Else
While Joursem > 1
If jour >= 1
Jour - 1
Joursem - 1
Select Joursem
Case DayOfWeek(PaquesLundi(Annee))
Jour + 1
EndSelect
Select Jour
Case 1
Select mois
Case 1, 5, 11 ;mois dont le 1 est férié
Jour + 1
EndSelect
EndSelect
DatePremierJourOuvre=Date(Annee,Mois,Jour,0,0,0)
If jour <= 1
Break
EndIf
EndIf
Wend
EndIf
ProcedureReturn FormatDate("%dd/%mm/%yyyy",DatePremierJourOuvre)
EndProcedure
Procedure.s JourOuvrable2(Annee,Mois)
Protected Jour=8, Joursem = 5 ;le deuxième samedi du mois tombe un samedi 8 ?
Protected DateDeuxiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
;Cherche le deuxieme samedi
While DayOfWeek(DateDeuxiemeJourOuvre)<>Joursem
Jour+1
DateDeuxiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Wend
;remonter la semaine jusqu'au Deuxieme lundi du mois, si le 8 n'est pas atteint
If Joursem = 1
DateDeuxiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Else
While Joursem > 1 ;lundi
If jour >= 1
Jour - 1
Joursem - 1
Select Jour
Case 8
Select mois
Case 5 ;mois dont le 8 est férié
If Joursem <= 1
Jour + 1
Break
ElseIf Joursem < 1
Jour + 1
EndIf
EndSelect
EndSelect
DateDeuxiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
If jour <= 1
Break
EndIf
EndIf
Wend
EndIf
ProcedureReturn FormatDate("%dd/%mm/%yyyy",DateDeuxiemeJourOuvre)
EndProcedure
Procedure.s JourOuvrable3(Annee,Mois)
Protected Jour=15, Joursem = 5 ;le troisième samedi tombe le 15 ?
Protected DateTroisiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
;Chercher le troisieme samedi
While DayOfWeek(DateTroisiemeJourOuvre)<>Joursem
Jour+1
DateTroisiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Wend
;remonter la semaine jusqu'au Troisieme lundi du mois, si le 11 n'est pas atteint
If Jour = 11
DateTroisiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Else
While Joursem > 1
If jour >= 1
Jour - 1
Joursem - 1
Select Jour
Case 11
Select mois
Case 11 ;11/11
If Joursem = 1
Jour + 1
Break
ElseIf Joursem < 1
Jour + 1
EndIf
EndSelect
Case 14
Select Mois
Case 7 ;14/07
If Joursem = 1
Jour + 1
Break
ElseIf Joursem < 1
Jour + 1
EndIf
EndSelect
Case 15
Select Mois
Case 8 ;15/08
If Joursem = 1
Jour + 1
Break
ElseIf Joursem < 1
Jour + 1
EndIf
EndSelect
EndSelect
DateTroisiemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
If jour <= 1
Break
EndIf
EndIf
Wend
EndIf
ProcedureReturn FormatDate("%dd/%mm/%yyyy",DateTroisiemeJourOuvre)
EndProcedure
Procedure.s JourOuvrable4(Annee,Mois)
Protected Jour=22, Joursem = 5 ;le quatrième samedi tombe le 22 ?
Protected DateQuatriemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
;Chercher le quatrieme samedi
While DayOfWeek(DateQuatriemeJourOuvre)<>Joursem
Jour+1
DateQuatriemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Wend
;remonter la semaine jusqu'au Quatrieme lundi du mois, si le 22 n'est pas atteint
If Joursem = 1
DateQuatriemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
Else
While Joursem > 1
If jour >= 1
Jour - 1
Joursem - 1
Select Joursem
Case DayOfWeek(PentecoteLundi(Annee))
Select Mois
Case 5
Jour + 1
EndSelect
EndSelect
Select Jour
Case 25
Select Mois
Case 12 ;25/12
If Joursem = 1
Jour + 1
Break
ElseIf Joursem < 1
Jour + 1
EndIf
EndSelect
EndSelect
DateQuatriemeJourOuvre=Date(Annee,Mois,Jour,0,0,0)
If jour <= 1
Break
EndIf
EndIf
Wend
EndIf
ProcedureReturn FormatDate("%dd/%mm/%yyyy",DateQuatriemeJourOuvre)
EndProcedure
Procedure.s JourOuvrable5(Annee,Mois)
Protected Jour=JoursDansMois(Annee,Mois)
Protected DateCinquiemeJourOuvre = Date(Annee,Mois,Jour,0,0,0)
Protected Joursem = 5
;Chercher le dernier samedi du mois
While DayOfWeek(DateCinquiemeJourOuvre) <> Joursem
Jour - 1
DateCinquiemeJourOuvre = Date(Annee,Mois,Jour,0,0,0)
Wend
;remonter la semaine jusqu'au dernier lundi du mois
If Joursem = 1
DateCinquiemeJourOuvre = Date(Annee,Mois,Jour,0,0,0)
Else
While Joursem > 1
If jour >= 1
Jour - 1
Joursem - 1
DateCinquiemeJourOuvre = Date(Annee,Mois,Jour,0,0,0)
If jour <= 1
Break
EndIf
EndIf
Wend
EndIf
ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateCinquiemeJourOuvre)
EndProcedure
;Test
CompilerIf #PB_Compiler_IsMainFile
For i = 1 To 12
Debug Left(NomJours(ParseDate("%dd/%mm/%yyyy", JourOuvrable1(Year(Date()), i))), 3) + " " + JourOuvrable1(Year(Date()), i) + " " +
Left(NomJours(ParseDate("%dd/%mm/%yyyy", JourOuvrable2(Year(Date()), i))), 3) + " " + JourOuvrable2(Year(Date()), i) + " " +
Left(NomJours(ParseDate("%dd/%mm/%yyyy", JourOuvrable3(Year(Date()), i))), 3) + " " + JourOuvrable3(Year(Date()), i) + " " +
Left(NomJours(ParseDate("%dd/%mm/%yyyy", JourOuvrable4(Year(Date()), i))), 3) + " " + JourOuvrable4(Year(Date()), i) + " " +
Left(NomJours(ParseDate("%dd/%mm/%yyyy", JourOuvrable5(Year(Date()), i))), 3) + " " + JourOuvrable5(Year(Date()), i)
Next i
CompilerEndIf