Automatisch afsluiten bestand

[snb]

Deze sluit al na 2 seconden:

CreateObject("Wscript.shell").Popup "wacht....", 2,"snb"

 

[CygneVoler]

Doe ik iets niet goed?

Zo ziet de mo***e 1 er uit:

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:00:40")
    WarningTime = DownTime - TimeValue("00:00:05")
      Application.OnTime WarningTime, "Afsluiten", , True
        Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=True
    End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
Sub ShutDown()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub
Sub Afsluiten()
CreateObject("Wscript.shell").Popup "Wacht....", 5, "SNB"
End Sub

En zo Thisworkbook

Private Sub Workbook_Open()
 With Sheets("ARTIKELEN")
   .Visible = True
   .Cells(1).CurrentRegion.Sort .Cells(1, 3), , , , , , , xlYes
   .Visible = xlVeryHidden
  End With
  'AutoSluiten.Show

Select Case CreateObject("WScript.Shell").Popup("wacht", 5, "Deze msgbox gaat weg na 5 seconden")
        Case -1 
    End Select
    
    Call SetTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For i = 6 To 6 'Sheets.Count
Sheets(i).Protect Password:="test"
Next
Call StopTimer
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub

 

[CygneVoler]

Uiteindelijk andere codes gebruikt. Werkt nu wel. Nogmaals bedankt voor jullie hulp.