L'idée est ici de faciliter particulièrement la tâche aux concepteurs de bases de données qui désirent cumuler des heures et des minutes (de travail par exemple), et d'obtenir un total d'heures de travail supérieur à 24 en gardant le format de Date/Heure standard
Cette fonction permet de calculer la somme de 2 ou plusieurs dates dont le total est éventuellement supérieur à 24 heures sans afficher un format du style "02:30" au lieu de "26:30"
Cette fonction prend en charge 2 paramètres : Interval, qui n'est autre que la somme de 2 ou plusieurs heures. Par exemple, imaginons un formulaire qui contient 2 champs Temps1 et Temps2. Interval pourrait très bien être : Temps1 + Temps2.
Le 2ème paramètre est Fmt (Format), qui est une chaîne de caractère devant faire partie de la liste énumérée ici-bas ("J H" , "H:MM", etc.)
EXEMPLE :
Admettons que le Champs Temps1 contienne 23:59, et le champs Temps2 contienne 01:00
MsgBox FormatInterval (Temps1 + Temps2 , "H:MM")
Affichera 24:59 (et non pas 00:59)
J'ai constaté que certaines des constantes de Fmt ne fonctionnaient pas complètement bien. Par contre les deux formats
H:MM
(24:59 par exemple) et
H:MM:SS (24:59:00 par exemple)
eux, fonctionnent parfaitement, et ça tombe bien, ce sont les 2 formats les plus intéressants.
' Cette fonction permet de renvoyer des formats de dates en heures, minutes et secondes supérieures à 24 heures
' Formats supportés (Dans le paramètre Fmt)
' J H 5 jours 5 heures
' J H:MM 5 jours 5:15
' J HH:MM 5 jours 05:15
' J H:MM:SS 5 jours 5:15:45
' J HH:MM:SS 5 jours 05:15:45
' H M 125 heures 15 Minutes
' H:MM 125:15
' H:MM:SS 125:15:45
' M S 7515 Minutes 45 Secondes
Function FormatInterval(ByVal Interval As Variant, Fmt As String)
Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long
' S'agit-il d'une date ou d'un nombre à virgule ?
If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then Exit Function
Days = Int(Interval)
Interval = Interval - Days
If Interval > #11:59:59 PM# Then
Days = Days + 1
Interval = 0#
End If
Interval = Interval * 24
Hours = Int(Interval)
Interval = Interval - Hours
If Interval > 3599# / 3600# Then
Hours = Hours + 1
Interval = 0#
End If
Interval = Interval * 60
Minutes = Int(Interval)
Interval = Interval - Minutes
If Interval > 59# / 60# Then
Minutes = Minutes + 1
Interval = 0#
End If
Seconds = Int(Interval * 60 + 0.5)
If Seconds = 60 Then
Minutes = Minutes + 1
Seconds = 0
End If
If Minutes > 59 Then
Hours = Hours + 1
Minutes = Minutes - 60
End If
If Hours > 23 Then
Days = Days + 1
Hours = Hours - 24
End If
Select Case Fmt
Case "J H"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours &
IIf(Hours <> 1, " Heures", " Heure")
Case "J H:MM"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours & ":" & Format(Minutes, "00")
Case "J HH:MM"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours &
Format(Hours, "00") & ":" & Format(Minutes, "00")
Case "J H:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "J HH:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Jours ", " Jour ") & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" & Format(Seconds, 0)
Case "H M"
Hours = Hours + Days * 24
FormatInterval = Days & IIf(Days <> 1, "Jours ", " Jour ") & Hours & Minutes & IIf(Minutes <> 1, "Minutes", " Minute")
' Le cas le plus intéressant, et qui marche :
Case "H:MM"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00")
' Le 2ème cas le plus intéressant qui marche :
Case "H:MM:SS"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "M S"
Minutes = Minutes + (Hours + Days * 24) * 60
FormatInterval = Minutes & IIf(Minutes <> 1, " Minutes ", " Minute ") & Seconds & IIf(Seconds <> 1, " Secondes", " Seconde")
Case Else
FormatInterval = "Format invalide"
End Select
End Function