Gestion des heures de nuit (22h-0h) - calcul de dates

Soyez le premier à donner votre avis sur cette source.

Snippet vu 12 208 fois - Téléchargée 17 fois

Contenu du snippet

Ce script utilise les fonctions FormatDateTime, TimeSerial, DateDiff, Hour et Minute pour calculer les heures de travail de nuit (de 22h00 à 06h00).
J'ai volontairement scindé le calcul des dates (par facilité et pour lisibilité):
- si date1 = date2, le calcul s'effectue sur la même journée;
- si date1 <> date2, le calcul s'effectue sur date1 et date2(date1 +1).

Source / Exemple :


'Gestion des heures de nuit (22h00 - 06h00)
'---------------------------------------------
' 
Option Explicit

'Exemples d'utilisation
MsgBox Demo(),,"Fonction Demo: Heures de nuit comprises entre 22h et 06h"

MsgBox MaDate("07/11/2007 20h05","07/11/2007 23h15") _
       ,,"Fonction MaDate: Heures de nuit comprises entre 22h et 06h"

'-----------------------------------------------------------------------------
Function Demo()
Dim DateDebut, DateFin, Diff, i, Result
Dim Exemple(12)
'Déclaration du tableau Exemple
Exemple(0)  = Array("07/11/2007","06h05","07/11/2007","20h20")
Exemple(1)  = Array("07/11/2007","20h05","07/11/2007","23h15")
Exemple(2)  = Array("07/11/2007","22h15","07/11/2007","23h20")
Exemple(3)  = Array("08/11/2007","00h05","08/11/2007","05h20")
Exemple(4)  = Array("08/11/2007","00h05","08/11/2007","07h20") 
Exemple(5)  = Array("07/11/2007","20h05","08/11/2007","00h15")
Exemple(6)  = Array("07/11/2007","20h05","08/11/2007","06h15")
Exemple(7)  = Array("07/11/2007","23h30","08/11/2007","05h20")
Exemple(8)  = Array("07/11/2007","23h30","08/11/2007","08h20")
Exemple(9)  = Array("07/11/2007","06h05","07/11/2007","06h05")  
Exemple(10) = Array("07/11/2007","06h05","09/11/2007","06h05")  
Exemple(11) = Array("09/11/2007","06h05","07/11/2007","06h05") 

For i=0 To UBound(Exemple)-1
    DateDebut =  CDate(Exemple(i)(0) & Space(1) & Replace(LCase(Exemple(i)(1)),"h",":"))
    DateFin   =  CDate(Exemple(i)(2) & Space(1) & Replace(LCase(Exemple(i)(3)),"h",":"))
    
    'Différence en minutes entre les 2 dates
    Diff =  DateDiff("n",DateDebut,DateFin)
    
    'Exécution de la fonction VerifHeuresNuit avec comme variables:
    'DateDebut=jj/mm/ aaaa hh:mn:ss 
    'DateFin=jj/mm/ aaaa hh:mn:ss 
    'Diff=DateFin-DateDebut en minutes
    'et replace de : par h
    Result = Result &vbCrLf& i+1 &vbTab& "Debut : " & _
             DateDebut &Space(2)& "Fin : " & DateFin &vbTab& "Heures nuit : " & _
             Replace(VerifHeuresNuit(DateDebut, DateFin, Diff),":","h")
Next
Demo = Result
End Function
'-----------------------------------------------------------------------------
Function MaDate(DateDebut, DateFin)
Dim Diff
'Différence en minutes entre les 2 dates
DateDebut =  Replace(LCase(DateDebut),"h",":")
DateFin   =  Replace(LCase(DateFin),"h",":")
Diff =  DateDiff("n",DateDebut,DateFin)
MaDate = "Debut : " & DateDebut &Space(2)& "Fin : " & DateFin &vbTab& "Heures nuit : " & _
         Replace(VerifHeuresNuit(DateDebut, DateFin, Diff),":","h")

End Function
'-----------------------------------------------------------------------------
Function VerifHeuresNuit(DateDebut, DateFin, Diff)
'DateFin - DateDebut limitée à 15h00
If Diff > 0 And Diff < 900 Then
 
   'Comparaison DateDebut et DateFin (selon paramètres généraux)
   'FormatDateTime(Date,vbShortDate) retourne une date  au format jj/mm/aaaa  
   'FormatDateTime(Date,vbShorTime)  retourne une heure au format hh:mm 
   Select Case CBool(FormatDateTime(DateDebut, vbShortDate) = FormatDateTime(DateFin, vbShortDate))
     
     'DateDebut = DateFin  format jj/mm/aaaa
     Case True
     
          If Hour(DateDebut) >= 6 And Hour(DateFin) =< 22 Then
             VerifHeuresNuit = FormatDateTime(TimeSerial(0, 0 , 0), vbShortTime) 

          ElseIf Hour(DateDebut) < 22 And Hour(DateFin) >= 22 Then
             'Hour(DateDebut) étant < 22h, DateDebut=jj/mm/aaaa 22:00:00
             DateDebut = FormatDateTime(DateDebut, vbShortDate) & Space(1) & TimeSerial(22,0,0) 
             VerifHeuresNuit = FormatDateTime(TimeSerial(0,0 + DateDiff("n",DateDebut, CDate(DateFin)),0), vbShortTime)

          ElseIf (Hour(DateDebut) >= 22 And Hour(DateFin) >= 22) Or _
                 (Hour(DateDebut) >= 0 And Hour(DateFin) < 6) Then
             VerifHeuresNuit = FormatDateTime(TimeSerial(0, 0 + Diff, 0), vbShortTime) 
          
          ElseIf Hour(DateDebut) >= 0 And Hour(DateFin) >= 6 Then 
             'Hour(DateFin) étant > 6h, DateFin=jj/mm/aaaa 06:00:00 
             DateFin = FormatDateTime(DateFin, vbShortDate) & Space(1) & TimeSerial(6,0,0)
             VerifHeuresNuit = FormatDateTime(TimeSerial(0, 0 + _ 
                               DateDiff("n",DateDebut, DateFin), 0), vbShortTime)
          End If
          Exit Function
   
 
   'date1 < date2
   Case False
   
          If Hour(DateDebut) < 22 And Hour(DateFin) < 6 Then
             VerifHeuresNuit = FormatDateTime(TimeSerial(0, 0 + _ 
                               DateDiff("n",FormatDateTime(DateDebut, vbShortDate) & _
                               Space(1) & TimeSerial(22,0,0),DateFin), 0), vbShortTime)
                               
          ElseIf Hour(DateDebut) < 22 And Hour(DateFin) >= 6 Then  
             VerifHeuresNuit = FormatDateTime(TimeSerial(8, 0 , 0), vbShortTime) 
           
          ElseIf Hour(DateFin) < 6 Then 
             VerifHeuresNuit = FormatDateTime(TimeSerial(0, 0 + Diff, 0), vbShortTime)
           
          ElseIf Hour(DateFin) > 6 Then
             'Hour(DateFin) étant > 6h, DateFin=jj/mm/aaaa 06:00:00 
             DateFin = FormatDateTime(DateFin, vbShortDate) & Space(1) & TimeSerial(6,0,0) 
             VerifHeuresNuit = FormatDateTime(TimeSerial(0, 0 + _ 
                               DateDiff("n",DateDebut, DateFin), 0), vbShortTime)
                
   End If
   Exit Function
   End Select
End If
VerifHeuresNuit = "dates non conformes"
End Function

Conclusion :


Via PCPT, ce script a évolué mais reste certainement perfectible de par vos remarques.

A voir également

Ajouter un commentaire

Commentaires

PCPT
Messages postés
13298
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
25 -
salut,

euh... perso je m'y perds avec tes "exemple X" dans le retour de la fonction.
logiquement tu devrais avoir 8 appels de fonction avec les bons paramètres non???
cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
23 -
Bonsoir PCPT,
Je vais regarder pour mettre les variables dans un tableau ou un dictionnaire,
et rajouter quelques commentaires.
Est-ce que vb6 "possède" l'objet "Scripting.Dictionary" ?
PCPT
Messages postés
13298
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
25 -
oui (à référencer manuellement)
PCPT
Messages postés
13298
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
25 -
tu ne dois pas avoir les exemples DANS la fonction
cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
23 -
Bonjour PCPT,
Je corrige:
- replace split par array
- suppresion du datefin dans exemple5
- suppression du numéro d'exemple
- nombre d'exemples
et commentaires.
J'ai posté trop vite !!!
Sur le principe, la fonction est ok.
Par contre, j'aimerais bien éviter le -22 dans
FormatDateTime(TimeSerial(Hour(DateFin) - 22, Minute(DateFin), 0),vbShortTime)

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.