VBA zum automatischem Schließen
25.03.2022 07:14:34
Lara
wir haben das Problem, dass User immer wieder Dateien nicht schließen und im schlimmsten Fall bis zum nächsten Morgen geöffnet lassen.
Dieses Problem habe ich schon lösen können, die Datei schließt sich jetzt nach 15 Minuten Inaktivität automatisch.
Dazu ist unter "Diese Arbeitsmappe" folgendes hinterlegt:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Call AutoCloseStop
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
AutoCloseStop
AutoCloseStart
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
AutoCloseStop
AutoCloseStart
End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
AutoCloseStop
AutoCloseStart
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
AutoCloseStop
AutoCloseStart
End Sub
Public Const ciIntervall As Integer = 1
Public Const dsMacro As String = "AutoClose"
Public gdNextTime As Double
Private iWait As Integer
Const cMax = 900 ' -> 15 Minuten
Dim Zeit As Date
Sub AutoClose()
iWait = iWait + 1
If cMax - iWait > 0 Then
Application.StatusBar = Format(Zeit - TimeSerial(0, 0, iWait), "hh:mm:ss")
gdNextTime = Now + TimeSerial(0, 0, ciIntervall)
Application.OnTime gdNextTime, dsMacro
Else
ThisWorkbook.Save
ThisWorkbook.Close
End If
End Sub
Sub AutoCloseStart()
iWait = 0
Zeit = TimeSerial(0, 0, cMax)
Application.StatusBar = Zeit
Call AutoClose
End Sub
Sub AutoCloseStop()
On Error Resume Next
Application.StatusBar = ""
Application.OnTime earliesttime:=gdNextTime, _
procedure:=dsMacro, schedule:=False
End Sub
Was leider nicht mehr funktioniert ist das manuelle schließen der Datei mit dem Timer, sobald eine zweite Datei geöffnet ist.
Er schließt zwar die Datei, öffnet Sie jedoch direkt wieder neu. Das mit dem manuellen schließen klappt nur, wenn keine andere Datei geöffnet ist.
Hat jemand eine Idee, was ich an der Datei ändern muss, damit das klappt?
Vielen Dank schonmal :)