Soru otomatik kapatma problemi

[incsoft]

Aşağıdaki koda göre aktif dosya 10 dakika sonra kapatılıyor arkadaşlar ancak şöyle bir sorun var. Örneği dosya ile işim bitti ve 3 dk sonra kapattım. Bu sefer 7 dk sonra kapatılan dosyayı yeniden açıyor. Bunu kodda nasıl bir değişikli yaparak çözebiliriz?


ÇALIŞMA KİTABI KODLARI

Option Explicit

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub



MODÜL KODU

Public CloseDownTime As Variant

Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:10:00") ' hh:mm:ss
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub

Public Sub CloseDownFile()
On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=True
End Sub

 

[Korhan Ayhan]

Çalışma kitabı bölümüne aşağıdaki satırları ekleyip deneyiniz.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not IsEmpty(CloseDownTime) Then
        Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
    End If
End Sub

 

[incsoft]

Çalışma kitabı bölümüne aşağıdaki satırları ekleyip deneyiniz.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not IsEmpty(CloseDownTime) Then
        Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
    End If
End Sub

 

[Korhan Ayhan]

Mesajımı dikkatli okursanız uygulayabilirsiniz.

 

[incsoft]

Mesajımı dikkatli okursanız uygulayabilirsiniz.

Mesajımı dikkatli okursanız uygulayabilirsiniz.

bunu başka dosyalarımda yapabildim hocam ancak bu dosyamda farklı işlemlerde olduğundan sürekli bu hatayı verdiği için çözemedim.



Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not IsEmpty(CloseDownTime) Then
Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case Val(Sh.Name)
Case 1 To 31: Call Module3.Aktar
End Select
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Val(Sh.Name)
Case 1 To 31: Call Module3.Aktar
End Select
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Val(Sh.Name)
Case 1 To 31: Call Module3.Aktar
End Select
End Sub

 

[Korhan Ayhan]

O zaman dosyanızı ekleyin. Hataya sebep olan durumu inceleyelim.

 

[incsoft]

O zaman dosyanızı ekleyin. Hataya sebep olan durumu inceleyelim.

workbook değil başka bir çalışma sayfasına da ekleyince olmuyor hocam. Ekleyim

 

[incsoft]

O zaman dosyanızı ekleyin. Hataya sebep olan durumu inceleyelim.

 

[Korhan Ayhan]

Eklediğiniz dosyada test etmek için süreyi 1 dakika olarak ayarladım. Dosyayı kapatıp tekrar açtım.

30. saniyede dosyayı kapattım. Sonra 1 dakika kadar bekledim. Dosya tekrar açılmadı. Yani benim denememde sorun çıkmadı.

Umarım sizde de çıkmaz.