Jours ouvrés

Programmation d'applications complexes
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Jours ouvrés

Message par Micoute »

Bonjour à tous,

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
j'espère que ça vous sera utile.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Jours ouvrés

Message par MLD »

Bonjour Micoute
super
La dernière colonne a droite ne serait doublée???
Mais quant on est immortel on ne compte pas le temps qui passe :lol: C'est ce que je me met dans la tête :lol: Je ne suis pas sur que cela marche :oops: :roll:
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Jours ouvrés

Message par Micoute »

Oui, quand on ne tient pas compte qu'il n'y a pas forcément 5 semaines qui commence par un jour ouvré, c'est pourquoi j'en ai fait un second qui en tient compte:

Code : Tout sélectionner

;Jours ouvrés

;il faut que chaque semaine commence un lundi, sauf si le jour est férié

EnableExplicit

Structure sJo
  Js.s
  J.s[5]
  M.s[5]
  A.s[5]
EndStructure

Global i, Jo.sJo, DatePremierJourOuvre, DateDeuxiemeJourOuvre, DateTroisiemeJourOuvre, DateQuatriemeJourOuvre, DateCinquiemeJourOuvre


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 ?
  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)
  With Jo
    \Js = StringField(NomJours(DatePremierJourOuvre), 1, " ")
    \J[0] = RSet(Str(Day(DatePremierJourOuvre)),2,"0")
    \M[0] = RSet(Str(Month(DatePremierJourOuvre)),2,"0")
    \A[0] = Str(Year(DatePremierJourOuvre))
    ProcedureReturn Left(\Js,3) + " " + \J[0] + "/" + \M[0] + "/" + \A[0]
  EndWith
EndProcedure

Procedure.s JourOuvrable2(Annee,Mois)
  Protected Jour=8, Joursem = 5 ;le deuxième samedi du mois tombe un samedi 8 ?
  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)
  With Jo
    \Js = StringField(NomJours(DateDeuxiemeJourOuvre), 1, " ")
    \J[1] = RSet(Str(Day(DateDeuxiemeJourOuvre)),2,"0")
    \M[1] = RSet(Str(Month(DateDeuxiemeJourOuvre)),2,"0")
    \A[1] = Str(Year(DateDeuxiemeJourOuvre))
    ProcedureReturn Left(\Js,3) + " " + \J[1] + "/" + \M[1] + "/" + \A[1]
  EndWith
EndProcedure

Procedure.s JourOuvrable3(Annee,Mois)
  Protected Jour=15, Joursem = 5 ;le troisième samedi tombe le 15 ?
  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)
  With Jo
    \Js = StringField(NomJours(DateTroisiemeJourOuvre), 1, " ")
    \J[2] = RSet(Str(Day(DateTroisiemeJourOuvre)),2,"0")
    \M[2] = RSet(Str(Month(DateTroisiemeJourOuvre)),2,"0")
    \A[2] = Str(Year(DateTroisiemeJourOuvre))
    ProcedureReturn Left(\Js,3) + " " + \J[2] + "/" + \M[2] + "/" + \A[2]
  EndWith
EndProcedure

Procedure.s JourOuvrable4(Annee,Mois)
  Protected Jour=22, Joursem = 5 ;le quatrième samedi tombe le 22 ?
  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)
  With Jo
    \Js = StringField(NomJours(DateQuatriemeJourOuvre), 1, " ")
    \J[3] = RSet(Str(Day(DateQuatriemeJourOuvre)),2,"0")
    \M[3] = RSet(Str(Month(DateQuatriemeJourOuvre)),2,"0")
    \A[3] = Str(Year(DateQuatriemeJourOuvre))
    ProcedureReturn Left(\Js,3) + " " + \J[3] + "/" + \M[3] + "/" + \A[3]
  EndWith
EndProcedure

Procedure.s JourOuvrable5(Annee,Mois)
  Protected Jour=JoursDansMois(Annee,Mois)
  Protected Joursem = 5
  DateCinquiemeJourOuvre = Date(Annee,Mois,Jour,0,0,0)
  
  ;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
  If Day(DateCinquiemeJourOuvre) = Day(DateQuatriemeJourOuvre); And Jo\M[4] = Jo\M[3]
    With Jo
      \Js = ""
      \J[4] = ""
      \M[4] = ""
      \A[4] = ""
      ProcedureReturn ""
    EndWith
  Else
    ;ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateCinquiemeJourOuvre)
    With Jo
      \Js = StringField(NomJours(DateCinquiemeJourOuvre), 1, " ")
      \J[4] = RSet(Str(Day(DateCinquiemeJourOuvre)),2,"0")
      \M[4] = RSet(Str(Month(DateCinquiemeJourOuvre)),2,"0")
      \A[4] = Str(Year(DateCinquiemeJourOuvre))
      ProcedureReturn Left(\Js,3) + " " + \J[4] + "/" + \M[4] + "/" + \A[4]
    EndWith
  EndIf   
EndProcedure

;Test
CompilerIf #PB_Compiler_IsMainFile
  For i = 1 To 12
    Debug JourOuvrable1(Year(Date()), i) + " " +
          JourOuvrable2(Year(Date()), i) + " " +
          JourOuvrable3(Year(Date()), i) + " " +
          JourOuvrable4(Year(Date()), i) + " " +
          JourOuvrable5(Year(Date()), i)
  Next i
CompilerEndIf
et voilà le travail.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Répondre