add time as menu Free Excel Macros (VBA) | Excel Programs

'For online Excel courses click: https://www.excelsizeyeter.com/excelwithkenan.com/udemy_giris.php 
 
Option Explicit

Private Declare Function FindWindow _
        Lib "user32" _
        Alias "FindWindowA" _
       ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String _
       ) _
        As Long
                
 Private Declare Function SetTimer _
        Lib "user32" _
       ( _
        ByVal hWnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long _
       ) _
        As Long
        
 Private Declare Function KillTimer _
        Lib "user32" _
       ( _
        ByVal hWnd As Long, _
        ByVal nIDEvent As Long _
       ) _
        As Long

Private Declare Function GetCurrentVbaProject _
        Lib "vba332.dll" _
        Alias "EbGetExecutingProj" _
       ( _
        hProject As Long _
       ) _
        As Long
        
 Private Declare Function GetFuncID _
        Lib "vba332.dll" _
        Alias "TipGetFunctionId" _
       ( _
        ByVal hProject As Long, _
        ByVal strFunctionName As String, _
        ByRef strFunctionID As String _
       ) _
        As Long
        
 Private Declare Function GetAddr _
         Lib "vba332.dll" _
         Alias "TipGetLpfnOfFunctionId" _
       ( _
         ByVal hProject As Long, _
         ByVal strFunctionID As String, _
         ByRef lpfnAddressOf As Long _
       ) _
        As Long

Private WindowsTimer As Long
 Private ClockCBControl As CommandBarButton
 
Sub StartClockinMenu()
    Set ClockCBControl = _
      Application.CommandBars(1).Controls.Add( _
         Type:=msoControlButton, Temporary:=True)
    ClockCBControl.Style = msoButtonCaption
    ClockCBControl.Caption = Format(Now, "Long Time")
    fncWindowsTimer 1000
End Sub

Sub StopClockinMenu()
    fncStopWindowsTimer
    ClockCBControl.Delete
End Sub

Private Function fncWindowsTimer( _
                                 TimeInterval As Long _
                               ) As Boolean
  Dim WindowsTimer As Long
  WindowsTimer = 0
  If Val(Application.Version) > 8 Then
     WindowsTimer = SetTimer _
       ( _
        hWnd:=FindWindow("XLMAIN", Application.Caption), _
        nIDEvent:=0, _
        uElapse:=TimeInterval, _
        lpTimerFunc:=AddrOf_cbkCustomTimer _
       )
  Else
     WindowsTimer = SetTimer _
       ( _
        hWnd:=FindWindow("XLMAIN", Application.Caption), _
        nIDEvent:=0, _
        uElapse:=TimeInterval, _
        lpTimerFunc:=AddrOf("cbkCustomTimer") _
       )
  End If
  fncWindowsTimer = CBool(WindowsTimer)
End Function

Private Function fncStopWindowsTimer()
  KillTimer _
           hWnd:=FindWindow("XLMAIN", Application.Caption), _
           nIDEvent:=WindowsTimer
End Function

Private Function cbkCustomTimer _
        ( _
         ByVal Window_hWnd As Long, _
         ByVal WindowsMessage As Long, _
         ByVal EventID As Long, _
         ByVal SystemTime As Long _
        ) _
         As Long
  Dim CurrentTime As String
  On Error Resume Next
  ClockCBControl.Caption = Format(Now, "Long Time")
End Function

Private Function AddrOf _
       ( _
         CallbackFunctionName As String _
       ) _
         As Long
   Dim aResult As Long
   Dim CurrentVBProject As Long
   Dim strFunctionID As String
   Dim AddressOfFunction As Long
   Dim UnicodeFunctionName As String
   UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)
   If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
      aResult = GetFuncID _
       ( _
         hProject:=CurrentVBProject, _
         strFunctionName:=UnicodeFunctionName, _
         strFunctionID:=strFunctionID _
       )
       If aResult = 0 Then
          aResult = GetAddr _
                 ( _
                   hProject:=CurrentVBProject, _
                   strFunctionID:=strFunctionID, _
                   lpfnAddressOf:=AddressOfFunction _
                 )
          If aResult = 0 Then
             AddrOf = AddressOfFunction
          End If
       End If
   End If
 End Function
 
 Private Function AddrOf_cbkCustomTimer() As Long
   AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
 End Function
 
 Private Function vbaPass(AddressOfFunction As Long) As Long
   vbaPass = AddressOfFunction
 End Function

Sub StartClock()
   StartClockinMenu
End Sub

Sub StopClock()
   StopClockinMenu
End Sub

No	Macro Name
1	add time as menu
2	add time as menu (most reliable)
3	deleting the menu bar and creating a custom menu
4	excel operators hk
5	See buttons and numbers
6	seconds message in statusbar
7	receive a message with a macro
8	is the size of a file in bytes?
9	Create your own extensions and functions in excel
10	Track and Report User Changes in an Excel worksheet or workbook
11	Add Timestamp: With this code, a timestamp between 00: 00-23: 00 & nbsp; You can put
12	Add time and date annotation to cell in double-click
13	add toolbars to combo box and select from there
14	Add menu to file edit bar delete
15	double-click to add the date and time to the comment
16	customization of toolbars remains in the file menu
17	add and delete menus
18	add sheet / pages as menus
19	add excel sheets as menus
20	Add Quick Access to custom Lists. Add custom List Access to the Right-Click Menu

Excel Free Macros (VBA)

Add Time As Menu

Online Excel Courses

Services

How can we help you?

Subscribe to our Youtube Channel?

Keywords