Merhabalar
Bu örnek çok güzel. kod içerisinde belirlediğin süre içerisinde excel kullanılmazsa kendini kapatıyor.
Fakat burada ufak bir ayrıntı var.
Örneğin 3 tane excel dosyam var. aaa bbb ccc şeklinde
ben bu makroyu aaa excel dosyama yazdım. yani aaa excel dosyam işlem yapılmayınca...
Merhaba Sayın @turist ,
kodunu kullanıyorum ama yazdığım saat gelince otomatik mail göndermiyor.
Office 2016 kullanıyorum. Acaba 2016 da çalışmıyor mudur?
kodun tamamı şu şekilde;
değerli yardımlarınızı rica ederim.
...için 1 saniye olarak ayarladım. Siz dilediğiniz gibi değiştirebilirsiniz.
Option Explicit
Sub Auto_Open()
DoEvents
Application.OnTime Now + TimeValue("00:00:01"), "Yenile"
End Sub
Sub Yenile()
DoEvents
If Range("A1") = 100 Then
Range("A1") = 1
Else...
Bu code çok işime yaradı ama buna herhangi bir hücrenin değerini istediğimiz sayı aralığında örneğin 1 den 100 e kadar 1 den başlayarak 1 er 1 er artacak şekilde 100 geldiği zamanda tekrar 1 e dönecek şekilde düzenleyebilirmiyiz.
...If (Year(Cells(i, "C")) = Year(Date)) Then t(3) = t(3) + Cells(i, "B")
Next i
Range("F3").Resize(4, 1) = Application.WorksheetFunction.Transpose(t)
Call calistir
End Sub
Sub calistir()
Application.OnTime Now + TimeValue("00:00:03"), "Toplamlar"
End Sub
Aklıma zamanlı makro geliyor bunu kullanabilirsiniz. 3 saniye bir makronuz çalışır. Değiştirebilirsiniz.
Örneğin:
Sub calistir()
Application.OnTime Now + TimeValue("00:00:03"), "Toplamlar"
End Sub
Toplamlar makrosunun End Sub öncesine de Call calistir ekleyiniz.
Kodu görür görmez hatırladım..... Charles Pearson'un efsane kodlarından biri. Geçtiğimiz yıl bir trafik kazasında öldü.
http://www.cpearson.com/excel/OnTime.aspx
.
excel starttimer stoptimer olarak araştırınız.
Arşivimden bulduğum bir kod örneği.
'http://www.cpearson.com/excel/OnTime.aspx
Public RunWhen As Double
Public Const cRunIntervalSeconds = 120 ' 2 dakika
Public Const cRunWhat = ""The_Sub""
Sub StartTimer() ' Timer'ı başlatır
RunWhen = Now...
...= "AŞIYA 1 GÜN KALDI" Then
s1.Range("c19").Interior.ColorIndex = 6
End If
Set Alan = Nothing
Application.OnTime Now + TimeValue("00:00:01"), "Renk"
End Sub
Sub Renk()
DoEvents
Set Alan = s1.Range("c19")
If Not Alan Is Nothing Then...
...Variant
Private Temps As Date
Private Zaman As Date
Private Sub TimeSlot(Optional Reset As Boolean)
On Error Resume Next
Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot", Schedule:=False
If IsMissing(Reset) Or (Reset = False) Then
If (Zaman <= Gecikme) Then...
..._
ByVal wlange As Long, _
ByVal dwTimeout As Long) _
As Long
Sub Otomatik_Zamanlı_Kapama()
Application.OnTime Now + TimeValue("00:02:00"), "Formu_Kapat"
End Sub
Sub Formu_Kapat() ' Excelin otomatik kapanmasında kullanılıyor.
On Error Resume Next
Dim w As...
...Variant
Private Temps As Date
Private Zaman As Date
Private Sub TimeSlot(Optional Reset As Boolean)
On Error Resume Next
Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot", Schedule:=False
If IsMissing(Reset) Or (Reset = False) Then
If (Zaman <= Gecikme) Then...
...Yeni kodu olan vars gönderirse sevinirim. Aşağıdaki kodda değişiklikler gerekiyorsa yine destek rica ediyorum..
Sub Kapat()
Application.OnTime Now + TimeValue("00:10:00"), "Uyar"
End Sub
Sub Uyar()
Dim Mesaj As Object
On Error Resume Next
Hata.Clear
Set Mesaj = CreateObject("WScript.Shell")...
...istenirse kaldırılabilir.
Sub my_Procedure()
cvp = MsgBox("Dosya Kapansın mı ?", vbYesNo)
If cvp = vbYes Then
ActiveWorkbook.Save
Application.Quit
End If
End Sub
Sub auto_open()
Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure"
End Sub
...Call GecenSure
End Sub
Private Sub GecenSure()
ActiveCell = Format(Time - Saniye, "hh:mm:ss")
Zaman = Now + TimeValue("00:00:01")
Application.OnTime Zaman, "GecenSure"
End Sub
Sub Durdur()
Application.OnTime Zaman, "GecenSure", , False
ActiveCell = Format(Time - Saniye, "hh:mm:ss")
End Sub...
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.