menü olarak saat ekleme (en güvenilir) Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz. 
 
Sayfaların kod bölümüne ve Thisworkbooka
Option Explicit

'Modüle1 e
Option Explicit
Sub StartClock()
   StartClockinMenu
End Sub
Sub StopClock()
   StopClockinMenu
End Sub

'Modüle2 ye
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

Benzer Sonuçlar
No	Makro Adı
1	menü olarak saat ekleme (en güvenilir)
2	saati menü olarak ekleme
3	sayfaları menü olarak ekleme
4	excel sayfalarını menü olarak ekleme
5	menü çubuğunun silinmesi ve özel bir menünün oluşturulması
6	dosya düzen çubuğuna menü ekleme silme
7	sayfaların menü olarak listelenmesi
8	açılışta ayrı menü olarak araç düğmelerinden bir kaçını getirme
9	menü ekleme
10	var olan menü çubuğuna buton ekleme
11	excelde kendi eklenti ve fonksiyonlarınızı oluşturun
12	kitabı kilitleme. salt okunur olarak açma. makroları gizler
13	sayfada sağ fareye menü ekleme
14	mükemmel menü ekleme, dosya menüsünde yazdır, baskı önizle, sayfa yapısı kalır
15	aktif sayfada veri girilen hücrelere veri girildiği tarih ve saati açıklama olarak ekler
16	menü ekleme ve silme
17	dosya düzen menüsüne menü ekleme
18	dosya, düzen menüsüne menü ekleme
19	userform'u otomatik boyutlandırma
20	Özel Listelere Hızlı Erişim Ekle. Sağ Tıklama Menüsüne Özel Liste Erişimi Ekleme

Benzer Sonuçlar

Makro Adı

menü olarak saat ekleme (en güvenilir)

saati menü olarak ekleme

sayfaları menü olarak ekleme

excel sayfalarını menü olarak ekleme

menü çubuğunun silinmesi ve özel bir menünün oluşturulması

dosya düzen çubuğuna menü ekleme silme

sayfaların menü olarak listelenmesi

açılışta ayrı menü olarak araç düğmelerinden bir kaçını getirme

menü ekleme

var olan menü çubuğuna buton ekleme