saati menü olarak ekleme 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. 
 
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

Benzer Sonuçlar
No	Makro Adı
1	saati menü olarak ekleme
2	menü olarak saat ekleme (en güvenilir)
3	sayfaları menü olarak ekleme
4	excel sayfalarını menü olarak ekleme
5	aktif sayfada veri girilen hücrelere veri girildiği tarih ve saati açıklama olarak ekler
6	hücreye o anki saati , zamanı eklemek
7	excel dosyası belirli bir tarihten sonra açılmasın
8	menü çubuğunun silinmesi ve özel bir menünün oluşturulması
9	excelde kendi eklenti ve fonksiyonlarınızı oluşturun
10	Seri Numaraları Ekleme: Bu makro kodu, excel sayfanıza seri numaraları otomatik olarak eklemenize yardımcı olacaktır. Bu makroyu çalıştırdıktan sonra seri numaralar için maksimum sayı girmeniz gereken bir giriş kutusu gösterecektir ve bundan sonra bir sütundaki sütuna sayı ekleyecektir.
11	menü ekleme
12	listbox index numarasını öğrenme
13	buton komutlarina uyarı ekleme
14	ayları sayfa olarak ekleme
15	var olan menü çubuğuna buton ekleme
16	Özel Listelere Hızlı Erişim Ekle. Sağ Tıklama Menüsüne Özel Liste Erişimi Ekleme
17	sayfa aktif olunca sol üstbilgi olarak tarihi ekleme
18	Inputbox ile aktif hücreye açıklama ekleme
19	sayfadaki formüllü hücrelerin formüllerini açıklama olarak ekleme ve silme
20	userform'u otomatik boyutlandırma

Benzer Sonuçlar

Makro Adı

saati menü olarak ekleme

menü olarak saat ekleme (en güvenilir)

sayfaları menü olarak ekleme

excel sayfalarını menü olarak ekleme

aktif sayfada veri girilen hücrelere veri girildiği tarih ve saati açıklama olarak ekler

hücreye o anki saati , zamanı eklemek

excel dosyası belirli bir tarihten sonra açılmasın

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

excelde kendi eklenti ve fonksiyonlarınızı oluşturun

Seri Numaraları Ekleme: Bu makro kodu, excel sayfanıza seri numaraları otomatik olarak eklemenize yardımcı olacaktır. Bu makroyu çalıştırdıktan sonra seri numaralar için maksimum sayı girmeniz gereken bir giriş kutusu gösterecektir ve bundan sonra bir sütundaki sütuna sayı ekleyecektir.