Dim TheTime As Long
Sub StartTimer()
TheTime = Timer
Application.OnTime Now + TimeValue("00:10:00"), "CloseSave"
End Sub
Sub CloseSave()
If Timer - TheTime > 580 Then
ThisWorkbook.Close SaveChanges:=True
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
StartTimer
End Sub
Dim CloseTime As Date
Sub TimeSetting()
CloseTime = Now + TimeValue("00:40:00")
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
ActiveWorkbook.Close Savechanges:=True
End Sub
Private Sub Workbook_Open()
Call TimeSetting
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call TimeStop
Call TimeSetting
End Sub