Skip to main content

  | मौसम…

411 समाचार
Public archive edition · Attributed source reporting with original dates · AI drafts are excluded

411 REFERENCE · Wikibooks

Visual Basic for Applications/Delays Past Midnight

Reference material by Wikibooks contributors. This retains its source identity and is not 411 news reporting.

Summary This VBA module delays for a specified number of seconds. It will work in any MS Office application that can run VBA. The following points are worth noting: Most delay procedures have problems at midnight when the Timer function resets, so code that depends on the difference of two values that span that time will be in error, and will perhaps cause a failure. This procedure avoids such problems by also compensating for the number of lapsed days. As such it will be found useful in timing and clock applications, if not for measuring time, at least for deciding when the display is to be updated. For example; running a delay of twenty seconds from ten seconds to midnight (clock count 86390) to ten seconds after midnight (supposed clock count 86410) would reset at midnight, and would never reach the required end value. The problem is solved by adding one count of 86400 (the number of seconds in one day) to the stepped value for each time that a date transition is made. The anticipated resolution of the procedure is about 10-16mS, consistent with that of the system timer. It is perhaps of interest to note that the GetTickCount API while able to accept millisecond parameters is still limited to the same 10-16mS resolution of the system timer. The procedure parameter can take on integers and fractions of a second, provided comments about resolution are borne in mind. The Code Copy the following VBA code into a standard module in Excel, Word, or any other Office application that supports VBA. Option Explicit Sub testDelay() 'tests delay procedure MsgBox DelaySecs(1.1) 'seconds End Sub Function DelaySecs(nSecs As Single) As Boolean 'Delays for nSecs SECONDS. 'Avoids midnight reset problem. 'Typical resolution 10-16mS. Dim StartDate As Date Dim StartTime As Single Dim TimeNow As Single Dim Lapsed As Single 'get launch date and current timer StartTime = Timer StartDate = Date 'then loop until lapse of parameter time Do DoEvents 'allow form updates and breaks '86400 seconds per new day TimeNow = 86400 * (Date - StartDate) + Timer Lapsed = TimeNow - StartTime Loop Until Lapsed >= nSecs 'MsgBox Lapsed DelaySecs = True End Function See Also Wait Functions - Chip Pearson: Several other methods of delay are considered.