I am creating Access db which needs auto close the db using timer count down. for example, if I give 5 min then it should start count down displaying this time format 00:04:59
I have found several pieces of tips checking the web, but did not manage to fit the pieces to one working piece.
Below is working perfect. but in output i can see only min and sec 0:00. How to add code for hours as well (format 00:00:00)? I tried to add hours but it is not working
Public Loops As Integer
Private Sub Form_Load()
Me.TimerInterval = 1000
Form_Timer
End Sub
Private Sub Form_Timer()
Static StartTime As Date
Dim SecondsToCount As Integer
SecondsToCount = 15 'Set this variable to the total number of seconds to
count down
If Loops = 0 Then StartTime = Time
Min = (SecondsToCount - DateDiff("s", StartTime, Time)) \ 60
Sec = (SecondsToCount - DateDiff("s", StartTime, Time)) Mod 60
Me.TimeLeft.Caption = "Form will close in " & Min & ":" & Format(Sec,"00")
Loops = Loops + 1
If Me.TimeLeft.Caption = "Form will close in 0:00" Then
DoCmd.Close acForm, Me.Name
End If
End Sub
Use a textbox for display, Timer to get a better resolution, and a TimerInterval of 100 for a closer match.
Complete code-behind module of the form:
Option Compare Database
Option Explicit
Private WatchTime As Date
Private Sub Form_Load()
' Specify count down time.
Const CountDownSeconds As Long = 15
WatchTime = DateAdd("s", CountDownSeconds, Now)
Me!txtCount.Value = WatchTime
Me.TimerInterval = 100
End Sub
Private Sub Form_Timer()
Const SecondsPerDay As Long = 86400
Dim TimeLeft As Date
TimeLeft = CDate(WatchTime - Date - Timer / SecondsPerDay)
Me!txtCount.Value = TimeLeft
If TimeLeft <= 0 Then
Me.TimerInterval = 0
MsgBox "Time ran out!", vbExclamation, "Exit"
DoCmd.Close acForm, Me.Name
End If
End Sub
Related
The purpose of the program is to remind the user to take a break every 30 minutes. The timer also allows the user to input how often to remind them. The countdown works only once when it reaches zero, however, l want to repeat the process three times. Dice images are placeholders. Sorry for any rookie errors.
Here is the code:
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If lblHrs.Text = "0" And lblMin.Text = "0" And lblSec.Text = "0" Then
dice1 = Int(Rnd() * 6 + 1)
Select Case dice1
Case "1"
DiceRoll1.Image = My.Resources._1
Case "2"
DiceRoll1.Image = My.Resources._2
Case "3"
DiceRoll1.Image = My.Resources._3
Case "4"
DiceRoll1.Image = My.Resources._4
Case "5"
DiceRoll1.Image = My.Resources._5
Case "6"
DiceRoll1.Image = My.Resources._6
End Select
Timer1.Enabled = False
End If
Dim seconds As Double
Dim minutes As Double
Dim hours As Double
Double.TryParse(lblSec.Text, seconds)
Double.TryParse(lblMin.Text, minutes)
Double.TryParse(lblHrs.Text, hours)
If seconds = 0 And minutes <> 0 Then
lblSec.Text = 59
lblMin.Text = minutes - 1
ElseIf seconds > 0 Then
lblSec.Text = seconds - 1
End If
If minutes = 0 And hours <> 0 Then
lblMin.Text = 59
lblHrs.Text = hours - 1
End If
Dim Msg, Style, Title
Msg = "Time to rest and exercise." ' Define message.
Style = vbOKOnly + vbInformation ' Define buttons.
Title = "Rest reminder" ' Define title.
' Display message.
MsgBox(Msg, Style, Title)
End Sub
This is not a full answer to your question but I wanted to post a chunk of code so a comment was not a good option. This class will help you if you are trying to implement a countdown:
Public Class CountdownStopwatch
Inherits Stopwatch
Public Property Period As TimeSpan
Public ReadOnly Property Remaining As TimeSpan
Get
Dim timeRemaining = Period - Elapsed
Return If(timeRemaining > TimeSpan.Zero, timeRemaining, TimeSpan.Zero)
End Get
End Property
Public ReadOnly Property IsExpired As Boolean
Get
Return Elapsed >= Period
End Get
End Property
End Class
It's basically a Stopwatch with extra countdown functionality. For instance, if you want to do something for 10 minutes then you can do this:
myCountdownStopwatch.Period = TimeSpan.FromMinutes(10)
myCountDownStopwatch.Restart()
In the Tick event of your Timer, you can display the time remaining and prompt the user when time expires like this:
timeReaminingLabel.Text = myCountdownStopwatch.Remaining.ToString("m\:ss")
If myCountdownStopwatch.IsExpired Then
myTimer.Stop()
myCountdownStopwatch.Stop()
myCountdownStopwatch.Reset()
'Prompt user here.
End If
I have a timer set as a VB object in a spread sheet. It currently displays as
hh:mm:ss.00. I need it to display as seconds only (no miliseconds or minutes, IE 1:30 should show as 90).
Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single
Private Sub CommandButton1_Click()
StopTimer = False
Etime0 = Timer() - LastEtime
Do Until StopTimer
Etime = Int((Timer() - Etime0) * 100) / 100
If Etime > LastEtime Then
LastEtime = Etime
Label1.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
DoEvents
End If
Loop
End Sub
Private Sub CommandButton2_Click()
StopTimer = True
Beep
With New MSForms.DataObject
.SetText Label1.Caption
.PutInClipboard
End With
End Sub
Private Sub CommandButton3_Click()
StopTimer = True
Etime = 0
Etime0 = 0
LastEtime = 0
Label1.Caption = "00"
End Sub
I'm sure I'm simply overlooking something obvious but I'm not overly familiar with timers and formatting.
Please refer this link:
Convert HH:MM:SS string to seconds only in javascript
And try this:
var hms = '02:04:33'; // your input string
var a = hms.split(':'); // split it at the colons
// minutes are worth 60 seconds. Hours are worth 60 minutes.
var seconds = (+a[0]) * 60 * 60 + (+a[1]) * 60 + (+a[2]);
console.log(seconds);
This is probably the easiest and the most comprehensive way, as a minute has 60 seconds and one hour has 3600 seconds.
Thus 1 minute and 30 seconds would be 0*3600 + 1*60 + 30:
Public Sub TestMe()
Dim myTime As Date
myTime = TimeSerial(0, 1, 30)
Debug.Print Hour(myTime) * 3600 + Minute(myTime) * 60 + Second(myTime)
End Sub
It takes 1:30 and it returns 90. You may consider writing a separate function like this one as well:
Public Function TimeToSeconds(Optional hours As Long = 0, _
Optional minutes As Long = 0, _
Optional seconds As Long = 0) As Long
TimeToSeconds = hours * 3600 + minutes * 60 + seconds
End Function
I have a userform in Microsoft Excel that I want to use as a stopwatch. However the format of "hh:mm" does not allow it to go above 23:59 as it goes back to 00:00
Private Sub SpinButton2_SpinUp()
If InsertEvent.TextBox1 = vbNullString Then
InsertEvent.TextBox1 = "00:00"
Else
InsertEvent.TextBox1.Value = Format(DateAdd("n", 1, InsertEvent.TextBox1.Value), "hh:mm")
'InsertEvent.TextBox1.Value = TimeValue("mm:ss")
'InsertEvent.TextBox1.Value = Format(InsertEvent.TextBox1.Value, "hh:mm")
End If
End Sub
Is there anyway to format this so that it can work as a clock of total minutes? Ideally I need it to go to about 125 minutes or so (125:00) but it doesn't matter if it is unlimited.
You can't use the built in Date/Time functions for this as you want a representation that is not a Date/Time.
Assuming you want to read the spinner value into the textbox:
Private Sub SpinButton2_SpinUp()
Dim minutes As Integer: minutes = Val(InsertEvent.SpinButton2.Value)
Dim hh As Integer: hh = minutes \ 60
Dim mm As Integer: mm = minutes - (hh * 60)
InsertEvent.TextBox1.Text = Format$(hh, "00") & ":" & Format$(mm, "00")
End Sub
To use a manually entered value from the textbox as the starting up/down point you need to re-parse "hh:mm" back to minutes, for example in the textbox Exit event:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If (IsNumeric(TextBox1.Text)) Then
'// entering a number only assumes its minutes
SpinButton2.Value = TextBox1.Text
Exit Sub
End If
Dim hhmm() As String: hhmm = Split(TextBox1.Text, ":")
If (UBound(hhmm) = 1) Then
If (IsNumeric(hhmm(0)) And IsNumeric(hhmm(1))) Then
SpinButton2.Value = (hhmm(0) * 60) + hhmm(1)
Exit Sub
End If
End If
SpinButton2.Value = 0
End Sub
(Should add error checking for overflow/exceeding the spinners .Max property)
Problem:
I have searched extensively for this and cannot seem to get it to work. I have a timer running when the "StartBtn" is pressed:
Dim StopTimer As Boolean
Dim SchdTime As Date
Dim Etime As Date
Dim currentcost As Integer
Const OneSec As Date = 1 / 86400#
Private Sub ResetBtn_Click()
StopTimer = True
Etime = 0
[TextBox21].Value = "00:00:00"
End Sub
Private Sub StartBtn_Click()
StopTimer = False
SchdTime = Now()
[TextBox21].Value = Format(Etime, "hh:mm:ss")
Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub
Private Sub StopBtn_Click()
StopTimer = True
Beep
End Sub
Sub NextTick()
If StopTimer Then
'Don't reschedule update
Else
[TextBox21].Value = Format(Etime, "hh:mm:ss")
SchdTime = SchdTime + OneSec
Application.OnTime SchdTime, "Sheet1.NextTick"
Etime = Etime + OneSec
End If
End Sub
Then in another cell (say, C16) I have a manually entered value which is the hourly cost rate. I have a third cell that is calculating total cost by C16*current timer value.
What I want to do is record every 5 seconds after the "StartBtn" is clicked the current time and current calculated cost in another sheet. This is what I have started:
Sub increment()
Dim x As String
Dim n As Integer
Dim Recordnext As Date
n = 0
Record = [TextBox21].Value
Recordnext = [TextBox21].Value + OneSec
Range("B13").Value = Recordnext
Do Until IsEmpty(B4)
If [TextBox21].Value = Recordnext Then ActiveCell.Copy
Application.Goto(ActiveWorkbook.Sheets("Sheet2").Range("A1").Offset(1, 0))
ActiveSheet.Paste
Application.CutCopyMode = False
n = n + 1
Recordnext = [TextBox21].Value + 5 * (OneSec)
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
But it doesnt work. Any help would be appreciated.
I have tried to simplify your timer method down to what is actually needed.
Sheet1 code sheet
Option Explicit
Private Sub ResetBtn_Click()
bRun_Timer = False
'use the following if you want to remove the last time cycle
TextBox21.Value = Format(0, "hh:mm:ss")
End Sub
Private Sub StartBtn_Click()
bRun_Timer = True
dTime_Start = Now
TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
Range("D16").ClearContents
Call next_Increment
End Sub
Module1 code sheet
Option Explicit
Public bRun_Timer As Boolean
Public Const iSecs As Integer = 3 'three seconds
Public dTime_Start As Date
Sub next_Increment()
With Worksheets("Sheet1")
.TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
.Range("D16") = Sheet1.Range("C16") / 3600 * _
Second(TimeValue(Sheet1.TextBox21.Value)) '# of secs × rate/sec
Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _
Array(.TextBox21.Value, .Range("D16").Value)
End With
If bRun_Timer Then _
Application.OnTime Now + TimeSerial(0, 0, iSecs), "next_Increment"
End Sub
Note that the operation of transferring the data to Sheet2 is a direct value transfer¹ with no .GoTo, ActiveCell or Select.
It was not entirely clear to me what you were trying to do with the value transfer. I have stacked them one after another on Sheet1.
You would benefit by adding Option Explicit² to the top of all your code sheets. This requires variable declaration and if you misplace a public variable, you will quickly know.
¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
² Setting Require Variable Declaration within the VBE's Tools ► Options ► Editor property page will put the Option Explicit statement at the top of each newly created code sheet. This will avoid silly coding mistakes like misspellings as well as influencing you to use the correct variable type in the variable declaration. Variables created on-the-fly without declaration are all of the variant/object type. Using Option Explicit is widely considered 'best practice'.
I need to calculate the difference between two timestamps in milliseconds.
Unfortunately, the DateDiff-function of VBA does not offer this precision.
Are there any workarounds?
You could use the method described here as follows:-
Create a new class module called StopWatch
Put the following code in the StopWatch class module:
Private mlngStart As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function
You use the code as follows:
Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer
' Do whatever you want to time here
Debug.Print "That took: " & sw.EndTimer & "milliseconds"
Other methods describe use of the VBA Timer function but this is only accurate to one hundredth of a second (centisecond).
If you just need time elapsed in Centiseconds then you don't need the TickCount API. You can just use the VBA.Timer Method which is present in all Office products.
Public Sub TestHarness()
Dim fTimeStart As Single
Dim fTimeEnd As Single
fTimeStart = Timer
SomeProcedure
fTimeEnd = Timer
Debug.Print Format$((fTimeEnd - fTimeStart) * 100!, "0.00 "" Centiseconds Elapsed""")
End Sub
Public Sub SomeProcedure()
Dim i As Long, r As Double
For i = 0& To 10000000
r = Rnd
Next
End Sub
GetTickCount and Performance Counter are required if you want to go for micro seconds..
For millisenconds you can just use some thing like this..
'at the bigining of the module
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
'In the Function where you need find diff
Dim sSysTime As SYSTEMTIME
Dim iStartSec As Long, iCurrentSec As Long
GetLocalTime sSysTime
iStartSec = CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'do your stuff spending few milliseconds
GetLocalTime sSysTime ' get the new time
iCurrentSec=CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'Different between iStartSec and iCurrentSec will give you diff in MilliSecs
If Timer() precision is enough then you can just create timestamp by combining date and time with milliseconds:
Function Now2() As Date
Now2 = Date + CDate(Timer / 86400)
End Function
To calculate the difference between two timestamps in milliseconds you may subtract them:
Sub test()
Dim start As Date
Dim finish As Date
Dim i As Long
start = Now2
For i = 0 To 100000000
Next
finish = Now2
Debug.Print (finish - start) & " days"
Debug.Print (finish - start) * 86400 & " sec"
Debug.Print (finish - start) * 86400 * 1000 & " msec"
End Sub
Actual precision of that method is about 8 msec (BTW GetTickCount is even worse - 16 msec) for me.
You can also use =NOW() formula calcilated in cell:
Dim ws As Worksheet
Set ws = Sheet1
ws.Range("a1").formula = "=now()"
ws.Range("a1").numberFormat = "dd/mm/yyyy h:mm:ss.000"
Application.Wait Now() + TimeSerial(0, 0, 1)
ws.Range("a2").formula = "=now()"
ws.Range("a2").numberFormat = "dd/mm/yyyy h:mm:ss.000"
ws.Range("a3").formula = "=a2-a1"
ws.Range("a3").numberFormat = "h:mm:ss.000"
var diff as double
diff = ws.Range("a3")
Apologies to wake up this old post, but I got an answer:
Write a function for Millisecond like this:
Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
End Function
Use this function in your sub:
Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub
Besides the Method described by AdamRalph (GetTickCount()), you can do this:
Using the QueryPerformanceCounter() and QueryPerformanceFrequency() API Functions
How do you test running time of VBA code?
or, for environments without access to the Win32 API (like VBScript), this:
http://ccrp.mvps.org/ (check the download section for the "High-Performance Timer" installable COM objects. They're free.)