Sujet Précédent Sujet Suivant

Recherche équivalent de cette fonction (DateDiff avec exclusion de PLAGE HORAIRE

webmestreContrePouvoir Messages postés 2 Date d'inscription mercredi 8 novembre 2006 Statut Membre Dernière intervention 16 septembre 2009 - 16 sept. 2009 à 13:59
Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 - 23 mai 2012 à 11:18
Houyou !!
Auriez vous une portion de code en VBA qui permette d'extraire une plage horraire que l'on renseigne en variable ?

DateDiff permet de faire la différence entre 2 dates/heures/minutes mais si l'on souhaite exclure (pour mon cas) la période de 18h à 9h le lendemain matin, comment procéder ?

L'idée correspondrait à cette fonction existante : http://www.sqlfr.com/codes/CALCUL-DIFFERENCE-DATE-FONCTION-JOURS-FERIES-TRAVAILLES-PLAGE_50022.aspx

Mais que je recherche en VBA !

5 réponses

Réponse 1 / 5
Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 10
16 sept. 2009 à 15:48
Bonjour,

En voici la traduction de SQL vers VB6. Je n'ai rien testé et il est fort possible qu'il y ait des erreurs. En principe il ne devrait pas y avoir d'erreurs de compilation c'est tout ce que je peux prétendre.

J'ai modifié certains types car non directement transposables en VB et certains entiers sont devenus des bouléens par commodité. Il te suffit de comparer les 2 codes car ils sont en fait très similaires. 

Option Explicit

'    Ensemble de fonctions de calculs de date avec jours fériés
'===================================================================='



'''''''''''''''''''''''''''''''''''-
' FN_DATEDIFF_SELON_HORAIRES_ENTREPRISE
' calcule la différence en minutes entre deux dates
' en fonction des horaires de l'ENTREPRISE :
' ici : 08h00 - 18h00
'
' Déduit les nuits entre 18h00 et 08h00 le lendemain
' ainsi que les week-ends et les jours fériés
'''''''''''''''''''''''''''''''''''-
Private Function DateDiffEx(ByVal Date1 As Date, ByVal Date2 As Date) As Integer
      Dim DateCreCalcul As Date
      Dim NbJourneesNonTravaillees As Integer
      Dim NbNuits As Integer

      DateCreCalcul = Date1
      ' Si Date1 inférieure à l'heure d'ouverture
      If DatePart("h", Date1, vbMonday, vbFirstFourDays) < 9 Then
         DateCreCalcul = DateAdd("h", -DatePart("h", Date1, vbMonday, vbFirstFourDays) + 9, Date1)
         DateCreCalcul = DateAdd("n", -DatePart("n", DateCreCalcul, vbMonday, vbFirstFourDays), DateCreCalcul)
         DateCreCalcul = DateAdd("s", -DatePart("s", DateCreCalcul, vbMonday, vbFirstFourDays), DateCreCalcul)
'         SET @DateCreCalcul = DATEADD(millisecond, - DATEPART(millisecond, @DateCreCalcul), @DateCreCalcul)
      End
      ' Si Date1 supérieure à l'heure de fermeture
      If DatePart("h", Date1) >= 18 Then
         DateCreCalcul = DateAdd("h", -DatePart("h", Date1, vbMonday, vbFirstFourDays) + 18, Date1)
         DateCreCalcul = DateAdd("n", -DatePart("n", DateCreCalcul, vbMonday, vbFirstFourDays), DateCreCalcul)
         DateCreCalcul = DateAdd("s", -DatePart("s", DateCreCalcul, vbMonday, vbFirstFourDays), DateCreCalcul)
'         SET @DateCreCalcul = DATEADD(millisecond, - DATEPART(millisecond, @DateCreCalcul), @DateCreCalcul)
      End
      ' Si Date1 est un dimanche, on ajoute 1 jour et on commence à l'heure d'ouverture
      If DatePart("w", Date1) = 7 Then
         DateCreCalcul = DateAdd("d", 1, DateCreCalcul, vbMonday, vbFirstFourDays)
         DateCreCalcul = DateAdd("h", -DatePart("h", DateCreCalcul) + 9, DateCreCalcul, vbMonday, vbFirstFourDays)
         DateCreCalcul = DateAdd("m", -DatePart("m", DateCreCalcul), DateCreCalcul, vbMonday, vbFirstFourDays)
         DateCreCalcul = DateAdd("s", -DatePart("s", DateCreCalcul), DateCreCalcul, vbMonday, vbFirstFourDays)
'         SET @DateCreCalcul = DATEADD(millisecond, - DATEPART(millisecond, @DateCreCalcul), @DateCreCalcul)
      End
      ' Si Date1 est un samedi, on ajoute 2 jours et on commence à l'heure d'ouverture
      If DatePart("w", Date1) = 6 Then
         DateCreCalcul = DateAdd("d", 1, DateCreCalcul, vbMonday, vbFirstFourDays)
         DateCreCalcul = DateAdd("h", -DatePart("h", DateCreCalcul) + 9, DateCreCalcul, vbMonday, vbFirstFourDays)
         DateCreCalcul = DateAdd("m", -DatePart("m", DateCreCalcul), DateCreCalcul, vbMonday, vbFirstFourDays)
         DateCreCalcul = DateAdd("s", -DatePart("s", DateCreCalcul), DateCreCalcul, vbMonday, vbFirstFourDays)
'         SET @DateCreCalcul = DATEADD(millisecond, - DATEPART(millisecond, @DateCreCalcul), @DateCreCalcul)
      End

      NbJourneesNonTravaillees = 0
      NbNuits = DateDiff("d", DateCreCalcul, Date2, vbMonday, vbFirstFourDays)
      ' Si les 2 dates sont à des jours différents, on cherche le nombre de jours NON travaillés entre les 2 dates
         Dim Compteur_NbNuits As Integer
         Compteur_NbNuits = 0
         
         ' Dans une boucle, on balaye tous les jours entre les 2 dates pour compter le nombre de jours non travaillés
         While Compteur_NbNuits < NbNuits
            Compteur_NbNuits = Compteur_NbNuits + 1
            If dbo.FN_JourTravailleFerie(DateAdd(Day, NbJourneesNonTravaillees + 1, DateCreCalcul), 1) <> "X" Then
               NbJourneesNonTravaillees = NbJourneesNonTravaillees + 1
         End
      
      ' On calcule la différence en minutes et on retire :
      '  - la durée des des nuits en minutes
      '  - la durée des journées non travaillées en minutes
      DateDiffEx = (DateDiff("n", DateCreCalcul, Date2, vbMonday, vbFirstFourDays) - 840 * NbNuits - 600 * NbJourneesNonTravaillees)
End Function


'''''''''''''''''''''''''''''''''''-
' Ensembles de fonctions qui déterminent si un jour est travaillé,
' week-end ou férié
'
' Entrée : date à tester,
'       Considérer le samedi comme un jour férié ?
'          Par défaut les samedi sont considérés comme fériés
'          0 : est considéré travaillé
'          1 : est considéré férié
'
' Sortie : chaine de caractère
'          X :    jour travaillé
'          WE : Week-end
'          JF : Jour férié
'
' Exemples d'appel de la fonction :
'       dbo.FN_JourTravailleFerie(getdate(), 1)
'       dbo.FN_JourTravailleFerie('21/04/2009', 1)
'''''''''''''''''''''''''''''''''''-


'''''''''''''''''''''''''''''''''''-
' ================================================================= '
'''''''''''''''''''''''''''''''''''-
Private Function Mini(ByVal a As Double, ByVal b As Double) As Double
   Dim f As Double
   If a < b Then
      Mini = a
   Else
      Mini = b
   End If
End Function

'''''''''''''''''''''''''''''''''''-
' ================================================================= '
'''''''''''''''''''''''''''''''''''-
Private Function Maxi(ByVal a As Double, ByVal b As Double) As Double
   If a > b Then
      Maxi = a
   Else
      Maxi = b
   End If
End Function

'''''''''''''''''''''''''''''''''''-
' ================================================================= '
'''''''''''''''''''''''''''''''''''-
Private Function IsCorrectDate(ByVal JJ As Integer, ByVal MM As Integer, ByVal AAAA As Integer) As Boolean
    ' Hors plage
    If JJ < 1 Or JJ > 31 Or MM < 1 Or MM > 12 Then
        IsCorrectDate = False
    End If
    ' Mois de 30 jours
    If JJ 31 And (MM 4 Or MM = 6 Or MM = 9 Or MM = 11) Then
        IsCorrectDate = False
      End
    End If
    ' Mois de février
     If MM = 2 Then
         If JJ <= 28 Then
            IsCorrectDate = True
         Else
             If JJ > 29 Then
               IsCorrectDate = False
             Else
                If Not (JJ 29 And ((AAAA Mod 4 0 And AAAA Mod 100 <> 0) Or AAAA Mod 400 = 0)) Then
                     IsCorrectDate = False
                 Else
                     IsCorrectDate = True
               End If
           End If
       End If
       Else ' mois autre que fevrier
        IsCorrectDate = True
    End If
End Function

'''''''''''''''''''''''''''''''''''-
' ================================================================= '
'''''''''''''''''''''''''''''''''''-
Private Function ConvertDate(ByVal dtDate As Date) As String
   Dim iJour As Integer
   Dim iMois As Integer
   Dim sJour As String
   Dim sMois As String

   iJour = DatePart("d", dtDate, vbMonday, vbFirstFourDays)
   iMois = DatePart("m", dtDate, vbMonday, vbFirstFourDays)

   sJour = IIf(i_jour <= 9, "0", "") & CStr(i_jour)
   s_mois = IIf(i_mois <= 9, "0", "") & CStr(i_mois)
   ConvertDate = sJour & sMois
End Function



'''''''''''''''''''''''''''''''''''-
' ================================================================= '
'''''''''''''''''''''''''''''''''''-
Private Function FN_JourTravailleFerie(ByVal dtDate As Date, Optional ByVal iSamediFerie As Integer = 1) As String
' Cette fonction indique si le jour passé en argument est férié.
' Par défaut les samedi sont considérés comme fériés, mais le second
' paramètre permet de changer cela.

   Dim lgA    As Long
   Dim lgMPaq As Long
   Dim lgJPaq As Long
   Dim lgTmp1 As Long
   Dim lgTmp2 As Long
   Dim lgTmp3 As Long
   Dim stDate As String
   Dim dtPaq As Date
   Dim stPaq As String
   Dim blFerie As Boolean
   Dim stType As String

 
   stType = "X"
' Dimanche (et samedi)

   If iSamediFerie = 1 Then
      If DatePart("w", dtDate, vbMonday, vbFirstFourDays) 7 Or DatePart("w", dtDate, vbMonday, vbFirstFourDays) 6 Then
         blFerie = True
      Else
         blFerie = False
      End If
   Else
      If DatePart("w", dtDate, vbMonday, vbFirstFourDays) = 7 Then
         blFerie = True
      Else
         blFerie = False
      End If
   End If

   If blFerie Then
      stType = "WE"
   End If
  
   If Not blFerie Then
    stDate = ConvertDate(dtDate)
    ' Jours fériés fixes (1er janvier, 1er mai, 8 mai, 14 juillet, ...)
    If stDate "0101" Or stDate "0105" Or stDate = "0805" Or stDate = "1407" Or stDate = "1508" Or stDate = "0111" Or stDate = "1111" Or stDate = "2512" Then
        blFerie = True
     End If
 
   If Not blFerie Then
      lgA = Year(dtDate)
      lgTmp1 = (19 * (lgA Mod 19) + 24) Mod 30
      lgTmp2 = Mini(lgTmp1, Maxi(28, lgTmp1) - 1)
      lgTmp3 = 28 + lgTmp2 - ((3 + lgA - 1900 + ((lgA - 1900) / 4) + lgTmp2) Mod 7)
      lgMPaq = 3 + (lgTmp3 / 32)
   ' Remarque Le calcul du jour de pâques ne fonctionne pas toujours. L'arrondi est mauvais lorsqu'il y a une division : mettre un TRUNC(ladivision,0) pour garder la partie entière.
   ' http://www.sqlfr.com/codes/ORACLE-SQL-SERVER-2K-FONCTION-RETOURNANT-STATUS-OUVRE_27798.aspx
   ' SET @lgMPaq = 3 + round((@lgTmp3 / 32), 0)
    
      If (lgTmp3 < 32) Then
         Set lgJPaq = lgTmp3
      Else
         Set lgJPaq = lgTmp3 - 31
      End If
      
    ' Construction de la date du dimanche de Pâques
      Set stPaq = CStr(lgJPaq) + "/" + CStr(lgMPaq) + "/" + CStr(lgA)
      dtPaq = CDate(stPaq)
    ' Jours fériés mobiles (lundi de pâques, ascension, lundi de pentecôte)
    ' Pâques et Pentecôte non testés, puisqu'ils tombent tous les deux un dimanche.
    
      If (dtDate (dtPaq + 1)) Or (dtDate (dtPaq + 39)) Or (dtDate = (dtPaq + 50)) Then
         blFerie True
      End If
    
   End If
 
   If blFerie And stType = "X" Then
      stType = "JF"
   End
End Function


Have Fun
Calade
0
Réponse 2 / 5
webmestreContrePouvoir Messages postés 2 Date d'inscription mercredi 8 novembre 2006 Statut Membre Dernière intervention 16 septembre 2009
16 sept. 2009 à 15:55
Salut Calade, et merci beaucoup pour cette publication !!

Vu la vitesse du truc j'imagine qu'il existe un outil qui t'a permis de générer ca ? :-O

Cu +
0
Réponse 3 / 5
Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 10
16 sept. 2009 à 17:53
Pas à ma connaissance, mais si tu regardes mieux les 2 versions tu t'apercevras que les mêmes fonctions existent en SQL et VB, il suffit de changer l'accompagnement.

Bref c'est de la cuisine comme toute programmation.

Calade
0
Réponse 4 / 5
pirelli31 Messages postés 1 Date d'inscription jeudi 17 mai 2012 Statut Membre Dernière intervention 17 mai 2012
17 mai 2012 à 19:01
Bonjour,
Votre post est très ancien, mais il est tellement bien que je tente tout de meme de vous poser une question!!
Votre code est excatement ce que je recherche depuis plusieurs jours...
Je dois developper une base access, est il possible d'utiliser votre code avec Access?? Et si oui, comment appeler cette "fonction" à partir d'une requete???? JE N Y ARRIVE PAS!!! :((

Merci de votre aide!!!!
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 10
23 mai 2012 à 11:18
Bonjour,

Difficile de répondre car je n’utilise plus Access depuis 2 ans.

Le mieux serait d'essayer en sachant que Access est à peu près compatible avec SQL.


Calade
0

Discussions similaires

VB6 - Différence entre deux dates en AA MM et Jours
cpapy -
Naoufel -

13 réponses
difference en jours entre 2 dates (C#)
speedus95 -
speedus95 -

4 réponses
[VB 6.0] Difference entre deux dates
cs_med_ali -
crenaud76 -

2 réponses
function datediff
cerbain1 -
cerbain1 -

5 réponses
différence entre deux date
elwadeh -
baz187rem -

1 réponse
Rejoignez-nous