GESTION DES HEURES DE NUIT (22H-0H) - CALCUL DE DATES

'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