Autospeichern dann Datei schliessen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.OnTime Now + TimeValue("00:10:00"), "schliessen", , False End Sub Private Sub Workbook_Open() Application.OnTime Now + TimeValue("00:10:00"), "schliessen" End Sub Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Application.OnTime Now + TimeValue("00:10:00"), "schliessen", , False Application.OnTime Now + TimeValue("00:10:00"), "schliessen" End Sub

Hallo Peter,
hier eine andere Lösung.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

Private Sub Workbook_Open()
    lastChange = Now
    StartTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    lastChange = Now
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
Public RunWhen As Double
Public lastChange As Double

Public Const maxTimeIdle As Long = 30 'Leerlaufzeit in Minuten - anpassen!

Public Const cRunIntervalSeconds = 300 ' Intervall in Sekunden
Public Const cRunWhat = "chek_status"

Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
        schedule:=True
End Sub

Sub chek_status()

    If lastChange + TimeSerial(0, maxTimeIdle, 0) < Now Then

        '###wenn keine Meldung erscheinen soll, dann diesen Block entfernen oder auskommentieren!#######################
        If MsgBox(Space(30) & ThisWorkbook.Name & vbLf & vbLf & vbLf & _
            "Sie haben seit " & CStr(maxTimeIdle) & " Minuten keine eingabe getätigt!" & Space(40) & vbLf & vbLf & _
            "Klicken Sie auf [OK] um die Datei zu speichern und zu schliessen," & vbLf & _
            "oder auf [Abbrechen] um die Datei geöffnet zu lassen!", 49, ThisWorkbook.Name) = 1 Then
            '###############################################################################################################

            ThisWorkbook.Close True
            Exit Sub
        Else
            lastChange = Now
        End If
    End If

    StartTimer

End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime earliesttime:=RunWhen, _
        procedure:=cRunWhat, schedule:=False
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Autospeichern dann Datei schliessen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread