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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 12 126 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

Commenter la réponse de PCPT

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.