Results 1 to 1 of 1

Thread: Excel Add-In: Date and Time on MenuBar

  1. #1

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Excel Add-In: Date and Time on MenuBar

    Attached is an Excel Add-In that shows Current Date & Time on Menu Bar and updates them every seconds.



    ThisWorkbook Module:
    Code:
    Option Explicit
    
    Private Sub Workbook_Open()
       If Me.IsAddin = False Then
          Me.IsAddin = True
          Me.Save
       End If
       Application.OnKey "^{TAB}", "ToggleClock"
       Call ToggleClock
    End Sub
    
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
       Call TurnOffClock
    End Sub
    modClock Module:
    Code:
    Option Explicit
    
    Dim NextTime As Date
    Dim menuClock As CommandBarButton
    Const DTFormat = "dddd dd/mm/yyyy  hh:nn:ss AM/PM"
    
    Public Sub ToggleClock()
       If NextTime = 0 Then
          If menuClock Is Nothing Then SetMenuClock
          NextTime = Now
          StatusClock
       Else
          TurnOffClock
       End If
    End Sub
    
    Public Sub TurnOffClock()
       On Error Resume Next
       If Not menuClock Is Nothing Then
          menuClock.Delete
          Set menuClock = Nothing
       End If
       Application.OnTime NextTime, "StatusClock", , False
       NextTime = 0
    End Sub
    
    Private Sub StatusClock()
       If NextTime > 0 Then
          If menuClock Is Nothing Then SetMenuClock
          menuClock.Caption = Format(Now, DTFormat)
          Do
             NextTime = NextTime + TimeSerial(0, 0, 1)
          Loop Until NextTime > Date + Timer / 86400
          Application.OnTime NextTime, "StatusClock"
       End If
    End Sub
    
    Private Sub SetMenuClock()
       Dim cbc As CommandBarControl
       
       With Application.CommandBars("Worksheet Menu Bar")
          For Each cbc In .Controls
             If cbc.Tag = "myClock" Then
                Set menuClock = cbc
                Exit For
             End If
          Next
          If menuClock Is Nothing Then
             Set menuClock = .Controls.Add( _
                             Type:=msoControlButton, _
                             Before:=.Controls.Count + 1, _
                             Temporary:=True)
             With menuClock
                .BeginGroup = True
                .Enabled = False
                .FaceId = 33
                .TooltipText = "Press Ctrl+Tab to turn On/Off"
                .Style = msoButtonIconAndCaption
                .Caption = Format(Now, DTFormat)
                .Tag = "myClock"
             End With
          End If
       End With
    End Sub
    Attached Images Attached Images  
    Attached Files Attached Files
    • Don't forget to use [CODE]your code here[/CODE] when posting code
    • If your question was answered please use Thread Tools to mark your thread [RESOLVED]
    • Don't forget to RATE helpful posts

    • Baby Steps a guided tour
    • IsDigits() and IsNumber() functions • Wichmann-Hill Random() function • >> and << functions for VB • CopyFileByChunk

Posting Permissions

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



Click Here to Expand Forum to Full Width