Auto save and close with timer

[Theglyde]

I am trying to create a code so that the software when let open by an employee it will close on its own.

It works great except if someone actually clicked into a cell then the timer doesnt start as it is showing as active. Problem we have is that one is working and leaves at the end of shift and then next one can’t do anything unless that person comes back and closes it.

Tried many things and I have ideas but not sure how to code it... here is what I got

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Dim CloseTime As Date Sub TimeSetting() CloseTime = Now + TimeValue("00:00:45") 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

I was thinking to make a timer at worst that no matter what after 12 minutes the codes send to cell a1 automatically just before that timer example

sub jumpnext ()
range ("A1").select
End Sub

but still need timer that will start weather a cell is selected or not

 

[Theglyde]

Does anyone have any idea on how to do a cell move even if a cell is clicked in or cursor is blinking (active cell)

 

[Jaafar Tribak]

The OnTime Method is useless in this scenario.

You could start monitoring the message queue status periodically inside a loop or inside timer callback upon opening the workbook ... something like this :

- Code in the ThisWorkbook Module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetQueueStatus Lib "user32" (ByVal fuFlags As Long) As Long
#Else
    Private Declare Function GetQueueStatus Lib "user32" (ByVal fuFlags As Long) As Long
#End If

Private Const QS_KEY = &H1
Private Const QS_MOUSEMOVE = &H2
Private Const QS_MOUSEBUTTON = &H4
Private Const QS_MOUSE = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT = (QS_MOUSE Or QS_KEY)

Private bCancel as Boolean

Private Sub Workbook_Open()
    'Close the workbook if idle longer than 45 seconds.
    Call Close_Workbook_When_Idle_After(45)
End Sub


Private Sub Close_Workbook_When_Idle_After(ByVal TimeOut_In_Seconds As Single) ' In Seconds.

  Dim sngTimer As Single

  sngTimer = Timer

  Do While bCancel = False
    If GetQueueStatus(QS_INPUT) Then
       sngTimer = Timer
       DoEvents
    End If
    If Timer - sngTimer >= TimeOut_In_Seconds Then Exit Do
  Loop

  If bCancel = False Then
    ThisWorkbook.Close Savechanges:=True
  End If

End Sub

Unfortunately, continiously running a loop+DoEvents is ugly and has a performance impact .. Same with a windows timer.
The only other alternative (less costly) would be to use a system wide keyboard and Mouse hooks from a second hidden instance of excel but that would require lots of coding.