Skip to content

Instantly share code, notes, and snippets.

@blakewrege
Last active September 1, 2016 13:03
Show Gist options
  • Save blakewrege/0e86ae46dc0612303899fcb6f6a59fc9 to your computer and use it in GitHub Desktop.
Save blakewrege/0e86ae46dc0612303899fcb6f6a59fc9 to your computer and use it in GitHub Desktop.
Macro for saving and closing an excel sheet after inactivity
' Insert this code in a excel vba module
Dim DownTime As Date
' Sets the timer for the spreadsheet
Sub SetTimer()
DownTime = Now + TimeValue("00:10:00")
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=True
End Sub
' Warns the user then calls the shutdown function
Sub ShutDown()
DownTime = Now + TimeValue("00:01:00")
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDownFinal", Schedule:=True
Call Warn
End Sub
' Restarts the timer if spreadsheet is being used
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDownFinal", Schedule:=False
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=False
End Sub
' Displays warning for spreadsheet close
Sub Warn()
Dim Shell
Set Shell = CreateObject("WScript.Shell")
Shell.Run "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""ONE MINUTE TILL CLOSE DUE TO INACTIVITY"",10,""WARNING""))"
End Sub
' Informs the user then saves and closes the spreadsheet
Sub ShutDownFinal()
Dim Shell
Set Shell = CreateObject("WScript.Shell")
Shell.Run "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""SCHEDULE CLOSED DUE TO INACTIVITY. YOUR WORK WAS SAVED""))"
Application.DisplayAlerts = False
ThisWorkbook.Close savechanges:=True
End Sub
' Insert this code into ThisWorkbook
' Starts the timer on open
Private Sub Workbook_Open()
Call SetTimer
End Sub
' Stops the timer on close
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
' Restarts timer on calculation
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call StopTimer
Call SetTimer
End Sub
' Restarts timer on selection change
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Call StopTimer
Call SetTimer
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment