Gustav Brock
Gustav at cactus.dk
Sun May 11 01:43:58 CDT 2008
Hi Max
Unless just for a "fun" web site countdown function, this is slightly more complicated than so.
You should be able to modify the function FormatYearDayHourMinuteSecondDiff below to return the values ByRef.
And it won't cost you a dollar ...
/gustav
Public Function FormatYearDayHourMinuteSecondDiff( _
ByVal datTimeStart As Date, _
ByVal datTimeEnd As Date, _
Optional ByVal strSeparatorDate As String = " ", _
Optional ByVal strSeparatorTime As String = ":") _
As String
' Returns count of years, days, hours, minutes and seconds of difference
' between datTimeStart and datTimeEnd converted to
' years, days, hours and minutes and seconds as a formatted string
' with an optional choice of date and/or time separator.
'
' Should return correct output for a negative time span but
' this is not fully tested.
'
' Example:
' datTimeStart: #2006-05-24 10:03:02#
' datTimeEnd : #2009-04-17 20:01:18#
' returns : 2 328 09:58:16
'
' 2007-11-06. Cactus Data ApS, CPH.
Const cintSecondsHour As Integer = 60& * 60&
Dim intYears As Integer
Dim intDays As Integer
Dim intSeconds As Integer
Dim intHours As Integer
Dim datTime As Date
Dim strDatePart As String
Dim strTimePart As String
Dim strYDHMS As String
intYears = Years(datTimeStart, datTimeEnd)
datTimeStart = DateAdd("yyyy", intYears, datTimeStart)
intDays = Days(datTimeStart, datTimeEnd)
datTimeStart = DateAdd("d", intDays, datTimeStart)
intHours = DateDiff("h", datTimeStart, datTimeEnd)
datTimeStart = DateAdd("h", intHours, datTimeStart)
intSeconds = DateDiff("s", datTimeStart, datTimeEnd)
' Format year and day part.
strDatePart = CStr(intYears) & strSeparatorDate & CStr(intDays)
datTime = TimeSerial(intHours, 0, intSeconds Mod cintSecondsHour)
' Format hour, minute and second part.
strTimePart = Format(datTime, "hh\" & strSeparatorTime & "nn\" & strSeparatorTime & "ss")
strYDHMS = strDatePart & " " & IIf(datTime < 0, "-", "") & strTimePart
FormatYearDayHourMinuteSecondDiff = strYDHMS
End Function
Public Function Years( _
ByVal datDOB As Date, _
ByVal datNow As Date, _
Optional ByVal booLinear As Boolean) _
As Integer
' Returns the difference in full years between datDOB and datNow.
'
' Calculates correctly for:
' negative differences
' leap years
' dates of 29. February
' date/time values with embedded time values
' negative date/time values (prior to 1899-12-29)
'
' Optionally returns negative counts rounded down to provide a
' linear sequence of year counts.
' For a given datDOB, if datNow is decreased step wise one year from
' returning a positive count to returning a negative count, one or two
' occurrences of count zero will be returned.
' If booLinear is False, the sequence will be:
' 3, 2, 1, 0, 0, -1, -2
' If booLinear is True, the sequence will be:
' 3, 2, 1, 0, -1, -2, -3
'
' If booLinear is False, reversing datDOB and datNow will return
' results of same absolute value, only the sign will change.
' This behaviour mimics that of Fix().
' If booLinear is True, reversing datDOB and datNow will return
' results where the negative count is offset by -1.
' This behaviour mimics that of Int().
' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of years to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2000-11-03. Cactus Data ApS, CPH.
' 2000-12-16. Leap year correction modified to be symmetrical.
' Calculation of intDaysDiff simplified.
' Renamed from YearsDiff() to Years().
' 2000-12-18. Introduced cbytMonthDaysMax.
' 2007-06-22. Version 2. Complete rewrite.
' Check for month end of February performed with DateAdd()
' after idea of Markus G. Fischer.
' 2008-04-27. Version 2.1.
' Correction for calculation of linear age from Feb. 29th.
' to Feb. 28th of a previous non-leap year as documented
' by Lester Hui.
'
' Example:
' DOB: 2000-02-29, Today: 1999-02-28, Age linear: -1.
'
' Parameters renamed to stress that for age calculations
' first parameter must be Date of Birth as documented
' by Markus G. Fischer.
' 2008-04-27. Version 2.2
' Rewrite to correct negative years count bug.
Dim intSign As Integer
Dim intYears As Integer
' Find difference in calendar years.
intYears = DateDiff("yyyy", datDOB, datNow)
' For positive resp. negative intervals, check if the second date
' falls before, on, or after the crossing date for a full 12 months period
' while at the same time correcting for February 29. of leap years.
If DateDiff("d", datDOB, datNow) > 0 Then
If DateDiff("d", DateAdd("yyyy", intYears, datDOB), datNow) < 0 Then
' The last year is not a full year.
' Reduce year count by one.
intYears = intYears - 1
End If
Else
intSign = Sgn(DateDiff("d", DateAdd("yyyy", -intYears, datNow), datDOB))
If intSign <> 0 Then
If intSign < 0 Then
' The last year is not a full year.
' Reduce negative year count by one.
intYears = intYears + 1
End If
If booLinear Then
' Offset negative count of years to continuous sequence if requested.
If DateDiff("d", DateAdd("yyyy", intYears, datDOB), datNow) < 0 Then
' Time interval includes a partial year.
' Increase negative year count by one.
intYears = intYears - 1
End If
End If
End If
End If
' Return count of years as count of full 12 months periods.
Years = intYears
End Function
Public Function Days( _
ByVal datDateFirst As Date, _
ByVal datDateLast As Date) _
As Long
' Returns the difference in full days from datDateFirst to datDateLast.
' 2007-06-27. Cactus Data ApS, CPH.
Dim lngDays As Long
lngDays = DateDiff("d", datDateFirst, datDateLast)
If lngDays > 0 Then
' Decrease by 1 if time of first date is later than time of last date.
If DateDiff("s", datDateLast, DateAdd("d", lngDays, datDateFirst)) > 0 Then
lngDays = lngDays - 1
End If
End If
Days = lngDays
End Function
/gustav
>>> max.wanadoo at gmail.com 10-05-2008 16:43 >>>
Hi,
Has anybody any code that would do a count down in years,days,hrs,mins,sec
from a given date to now()
Ie, pass the function the future (or past) date and it updates given values
which are passed by Ref.
Thanks
Max