PDA

View Full Version : VB Stopwatch Code



DAWG2006
05-01-2009, 09:20 AM
Here's my lay out of a UserForm:

Dialog box with 3 buttons on the bottom with a Label on the top center.

First button: Start
Second: Reset/Save
Third: Stop

The label displays a stop watch timer that is controled by the buttons.


Now the only problem I'm having currently is I can't get the "Reset/Save" button to save the time into a spreadsheet. I'll paste the code below. Please help.
-----------------------------------------------------------



Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single
Private Sub cmdStartBtn_Click()
StopTimer = False
Etime0 = Timer() - LastEtime
Do Until StopTimer
Etime = Int((Timer() - Etime0) * 100) / 100
If Etime > LastEtime Then
LastEtime = Etime
ElapsedTimeLbl.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
DoEvents
End If
Loop
End Sub
Private Sub cmbResetBtn_Click()
StopTimer = True
Etime = 0
Etime0 = 0
LastEtime = 0
ElapsedTimeLbl.Caption = "00:00:00.00"
StopTimer = False
Etime0 = Timer() - LastEtime
Do Until StopTimer
Etime = Int((Timer() - Etime0) * 100) / 100
If Etime > LastEtime Then
LastEtime = Etime
ElapsedTimeLbl.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
DoEvents
End If
Loop
End Sub

Private Sub cmdStopBtn_Click()
StopTimer = True
Beep
End Sub

Bob Phillips
05-01-2009, 09:41 AM
Option Explicit

Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single

Private Sub cmdStartBtn_Click()
Call RunTimer
End Sub

Private Sub cmbResetBtn_Click()
StopTimer = True
With Worksheets(1).Range("A1")
If .Value = "" Then
.Value = ElapsedTimeLbl.Caption
ElseIf .Offset(1, 0).Value = "" Then
.Offset(1, 0).Value = ElapsedTimeLbl.Caption
Else
.End(xlDown).Offset(1, 0).Value = ElapsedTimeLbl.Caption
End If
End With
ElapsedTimeLbl.Caption = "00:00:00.00"
Call RunTimer
End Sub

Private Sub cmdStopBtn_Click()
StopTimer = True
Beep
End Sub

Private Function RunTimer()
Etime = 0
Etime0 = 0
LastEtime = 0
StopTimer = False
Etime0 = Timer() - LastEtime
Do Until StopTimer
Etime = Int((Timer() - Etime0) * 100) / 100
If Etime > LastEtime Then
LastEtime = Etime
ElapsedTimeLbl.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
DoEvents
End If
Loop
End Function

DAWG2006
05-01-2009, 10:02 AM
Thank you that works absolutely perfect.

mdmackillop
05-02-2009, 04:07 AM
Hi Dawg,
If you sect your code and click the green VBA button, it will format as shown, making it more readable.
Regards
MD