Zelle vor automatischer Speicherung verlassen
04.08.2016 12:39:46
Tobias
habe folgendes Problem:
VBA Code erzeugt und prüft einen zeitlichen Intervall und schließt und speichert bei Bedarf das Arbeitsmappe. Da funktioniert allerdings nicht, wenn die Zelle in Bearbeitung ist. Wie kann ich die Zelle beispielweise vorher escapen und, wo muss dieses Code eingefügt werden?
Vielen Dank schon mal!
Hier der Code
'Arbeitsmappe:
Private Sub Workbook_Open()
LastActivityTime = Now
TimeCheck
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
On Error Resume Next
Application.OnTime EarliestTime:=LastActivityTime + Intervall, procedure:="Timecheck", _
schedule:=False
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
LastActivityTime = Now
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
LastActivityTime = Now
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
LastActivityTime = Now
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
LastActivityTime = Now
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If ActiveWorkbook.Name = ThisWorkbook.Name Then
LastActivityTime = Now
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
LastActivityTime = Now
End Sub
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
LastActivityTime = Now
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
LastActivityTime = Now
End Sub
'Modul
Public LastActivityTime
Public Intervall
Sub TimeCheck()
Intervall = TimeValue("01:00:15") 'Zeit setzen
If Now - LastActivityTime > Intervall Then
'Speichern und Schließen wenn Intervall abgelaufen ist !
ThisWorkbook.Save
ThisWorkbook.Close
Else
'Intervall ab letzer Aktivität neu setzen
Application.OnTime LastActivityTime + Intervall, "Timecheck"
End If
End Sub