Function FormatInterval(ByVal Interval As Variant, Fmt As String)
'
' Formats the difference between 2 dates or sum of 2 times
' to show day as well as hours, minutes, and seconds.
'
' Supports the following formats:
' D H 5 Days 5 Hours
' D H:MM 5 Days 5:15
' D HH:MM 5 Days 05:15
' D H:MM:SS 5 Days 5:15:45
' D HH:MM:SS 5 Days 05:15:45
' H M 125 Hours 15 Minutes
' H:MM 125:15
' H:MM:SS 125:15:45
' M S 7515 Minutes 45 Seconds
'
Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long
'
' Check for Date or Double
'
If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then Exit Function
'
' Parse Days
'
Days = Int(Interval)
Interval = Interval - Days
If Interval > #11:59:59 PM# Then
Days = Days + 1
Interval = 0#
End If
'
' Parse Hours
'
Interval = Interval * 24
Hours = Int(Interval)
Interval = Interval - Hours
If Interval > 3599# / 3600# Then
Hours = Hours + 1
Interval = 0#
End If
'
' Parse Minutes
'
Interval = Interval * 60
Minutes = Int(Interval)
Interval = Interval - Minutes
If Interval > 59# / 60# Then
Minutes = Minutes + 1
Interval = 0#
End If
'
' Parse Seconds
'
Seconds = Int(Interval * 60 + 0.5)
'
' Normalize
'
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
'
' Create format
'
Select Case Fmt
Case "D H"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours &
IIf(Hours <> 1, " Hours", " Hour")
Case "D H:MM"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours &
":" & Format(Minutes, "00")
Case "D HH:MM"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") &
Format(Hours, "00") & ":" & Format(Minutes, "00")
Case "D H:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "D HH:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "H M"
Hours = Hours + Days * 24
FormatInterval = Hours & IIf(Hours <> 1, " Hours ", " Hour ") & Minutes & IIf(Minutes <> 1, " Minutes", " Minute")
Case "H:MM"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00")
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, " Seconds", " Second")
Case Else
FormatInterval = Null
End Select
End Function
|