Results 1 to 22 of 22

Stopwatch / Timer

Threaded View

  1. #6
    Forum Expert tigeravatar's Avatar
    Join Date
    03-25-2011
    Location
    Colorado, USA
    MS-Off Ver
    Excel 2003 - 2013
    Posts
    5,361

    Re: Stopwatch / Timer

    bmasella,

    Attached is a Stopwatch/Timer excel program I made that fits all your requirements. I even set it up so that you could do a SaveAs -> .xla file so you can use it as an Excel Add in and it will be available in all of your workbooks if you want.

    Here's the code for the actual Stopwatch/Timer userform. To change which cell the TimeStamp gets output to, just change the cell reference in btn_TimeStamp_Click():
    Dim tPause As Boolean
    Dim ws As Worksheet
    
    Private Sub btn_Reset_Click()
        Me.lbl_Hour.Caption = "00"
        Me.lbl_Minute.Caption = "00"
        Me.lbl_Second.Caption = "00"
        Me.btn_Reset.Enabled = False
        Me.btn_TimeStamp.Enabled = False
    End Sub
    
    Private Sub btn_StartStopResume_Click()
        
        If Me.btn_StartStopResume.Caption = ws.[B2] Then
            Me.btn_StartStopResume.Caption = ws.[B3]
            Me.btn_Reset.Enabled = False
            Me.btn_TimeStamp.Enabled = False
            Dim tH As String:     tH = Me.lbl_Hour.Caption
            Dim tM As String:     tM = Me.lbl_Minute.Caption
            Dim tS As String:     tS = Me.lbl_Second.Caption
            Dim tStart As Double: tStart = Timer - (tH * 3600 + tM * 60 + tS)
            tPause = False
            While tPause = False
                DoEvents
                tH = Int((Timer - tStart) / 3600):              If Len(tH) < 2 Then tH = "0" & tH
                tM = Int((Timer - tStart - tH * 3600) / 60):    If Len(tM) < 2 Then tM = "0" & tM
                tS = Int(Timer - tStart - tH * 3600 - tM * 60): If Len(tS) < 2 Then tS = "0" & tS
                Me.lbl_Hour.Caption = tH
                Me.lbl_Minute.Caption = tM
                Me.lbl_Second.Caption = tS
            Wend
        Else
            tPause = True
            Me.btn_StartStopResume.Caption = ws.[B2]
            Me.btn_Reset.Enabled = True
            Me.btn_TimeStamp.Enabled = True
        End If
        
    End Sub
    
    Private Sub btn_TimeStamp_Click()
        
        ActiveWorkbook.ActiveSheet.Range("B4").Value = Format(Me.lbl_Hour.Caption & ":" & Me.lbl_Minute.Caption & ":" & Me.lbl_Second.Caption, "hh:mm:ss")
        
    End Sub
    
    Private Sub UserForm_Initialize()
        tPause = True
        Set ws = ThisWorkbook.Sheets("Stopwatch")
        Me.btn_StartStopResume.Caption = ws.[B2]
        Me.btn_Reset.Enabled = False
        Me.btn_TimeStamp.Enabled = False
    End Sub
    
    Private Sub UserForm_Terminate()
        tPause = True
    End Sub


    Here's the code for the Add-in portion:
    Private Sub Workbook_AddinInstall()
        
        On Error Resume Next
        Application.CommandBars("Worksheet Menu Bar").Controls("Launch Stopwatch").Delete
        
        Dim StopwatchMacro
        Set StopwatchMacro = Application.CommandBars("Worksheet Menu Bar").Controls.Add
        With StopwatchMacro
            .Caption = "Launch Stopwatch"
            .Style = msoButtonCaption
            .OnAction = "LaunchStopwatch"
        End With
        
    End Sub
    
    Private Sub Workbook_AddinUninstall()
        
        On Error Resume Next
        Application.CommandBars("Worksheet Menu Bar").Controls("Launch Stopwatch").Delete
        
    End Sub
    Attached Files Attached Files
    Hope that helps,
    ~tigeravatar

    Forum Rules: How to use code tags, mark a thread solved, and keep yourself out of trouble

Thread Information

Users Browsing this Thread

There are currently 2 users browsing this thread. (0 members and 2 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1