PureBasic

Forums PureBasic
Nous sommes le Mer 18/Sep/2019 14:39

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 
Auteur Message
 Sujet du message: Jours ouvrés
MessagePosté: Jeu 16/Aoû/2018 9:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2172
Localisation: 50200 Coutances
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:
;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 GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Jours ouvrés
MessagePosté: Jeu 16/Aoû/2018 10:52 
Hors ligne

Inscription: Jeu 05/Fév/2009 17:58
Messages: 904
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:


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Jours ouvrés
MessagePosté: Jeu 16/Aoû/2018 11:00 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2172
Localisation: 50200 Coutances
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:
;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 GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 4 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye