Excel kronometre

Excel kronometre

Excel vba kronometre

Excel kronometre

Excel vba ortamında bir zaman sistemi oluşturmaya çalıştım.

Geri sayım ve kronometre

Excel vba bileşenleri:

Application.OnTime (Erkenzaman, çalıştırılacak prosedür, engeçzaman, program)

 

Örnekler:

15 saniye sonra çalıştır:

Application.OnTime Now + TimeValue("00:00:15"), "kronometre"

 

Saat 16’da çalıştır:

Application.OnTime TimeValue("16:00:00"), "kronometre"

 

İşlemin iptali:

Application.OnTime EarliestTime:=TimeValue("16:00:00"), "kronometre", Schedule:=False

 

Otomatik başlatma:

Sub auto_open

Application.OnTime Now() + TimeValue("00:00:01"), "kronometre"

End sub

 

 

Yazdığım kodlar:

Sub kronometrebaslat()

Application.OnTime Now() + TimeValue("00:00:01"), "kronometre"

 

End Sub

 

Sub kronometredurdur()

Application.OnTime Now() + TimeValue("00:00:01"), "kronometre", , False

 

End Sub

 

Sub kronometre()

Sayfa2.Range("d5").Value = Time

Application.OnTime Now() + TimeValue("00:00:01"), "kronometre"

End Sub

 

 

 

Mevcut kodlar:

sub Saat_baslat()

 

Sayfa1.Range("h3").Value = 0

 

Application.OnTime Now() + TimeValue("00:00:01"), "Saatdevam"

 

End Sub

 

 

Sub Saat_durdur()

 

Application.OnTime Now() + TimeValue("00:00:01"), "Saatdevam", , False

 

End Sub

 

Sub Saatdevam()

On Error Resume Next

 

 'Application.EnableEvents = False

 

If Sayfa1.Range("e17").Value Then

 

 

   If Sayfa1.Range("d5").Value = 0 Then

   MsgBox "SÜRE BİTTİ"

   Exit Sub

   End If

  

   Sayfa1.Range("d5").Value = Range("d5").Value - TimeValue("00:00:01")

 

   Application.OnTime Now() + TimeValue("00:00:01"), "Saatdevam"

     

Else

 

  Sayfa1.Range("a1").Value = Time

  Sayfa1.Range("d5").Value = Sayfa1.Range("a1").Value

 

  Application.OnTime Now() + TimeValue("00:00:01"), "Saatdevam"

 

  Application.OnTime Now + (TimeValue("00:00:01") / 1000), "degerartir"

 

End If

 

 'Application.EnableEvents = True

 

End Sub

 

Sub degerartir()

 

' kronometre için bir artırma sistemi

 

 Sayfa1.Range("h3").Value = Sayfa1.Range("h3").Value + 1

 

End Sub

 

 

https://youtu.be/-V0P4IWE7_c