![evet işte bu! [evet]](./images/smilies/yes.gif)
- Kod: Tümünü seç
Option Explicit
Private Const Gecikme As Date = 5 / 86400
Private Const Onerilen_Zaman As Date = 10 * 60 / 86400
Private Süre 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
ThisWorkbook.Close True
End If
Zaman = Zaman - Gecikme
Else
Zaman = Süre
End If
Temps = Now + Gecikme
Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot"
ActiveWindow.Caption = Split(ActiveWindow.Caption, " [")(0) & " [" & Zaman & "]"
End Sub
Private Sub Workbook_Open()
Do
Süre = Application.InputBox("Varsayılan zaman önerilmektedir " & Onerilen_Zaman & ". " & _
"Girdi formatı '00:00:00'" & vbCrLf & vbCrLf & _
"Kalan süre yukarıda gösterilecektir. " & vbCrLf, _
"Saati ayarlayın", Type:=2)
Loop Until (Süre = False) Or IsDate(Süre)
Süre = IIf(IsDate(Süre), Süre, Onerilen_Zaman)
TimeSlot True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
TimeSlot True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime Temps, Procedure:="ThisWorkbook.TimeSlot", Schedule:=False
End Sub