Excel Add-In: Date and Time on MenuBar

[anhn]

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



ThisWorkbook Module:

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:

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