Excel time cout count down in status bar

[ajayn]

Hello All,



I have code on how to make an excel file close automatically when idle for a specific time which is working fine.

I want to constantly show the countdown time until the timeout period of inactivity in the excel status bar. How do I do this? I tried below but obviously this will not work because it will update only when I touch the excel which I don't want to count inactivity




Thanks

Ajay N



CODE:

------





Module 1:

------------

Public NoActivity As Date
Public SuppressCalcEvent As Boolean


Public Sub ShutDown()
On Error Resume Next
Application.DisplayAlerts = False

SuppressCalcEvent = True
Call StopClock
With ThisWorkbook
.Save
.Close
End With

End Sub



Public Sub StartClock()
On Error Resume Next

NoActivity = Now + TimeValue("00:02:00")

Application.OnTime NoActivity, "ShutDown"

End Sub



Public Sub StopClock()

On Error Resume Next

Application.OnTime NoActivity, "ShutDown", , False

End Sub





Workbook Module:

--------------------



Private Sub Workbook_Open()


Call StartClock

End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)



End Sub







Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If SuppressCalcEvent Then Exit Sub
Call StopClock

Call StartClock

End Sub





Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Call StopClock

Call StartClock

End Sub

 

[Teeroy]

There's a way to do this with less processing overhead and you can update the status bar without resetting the counter.
Have a look at Close an excel workbook opened by another user on the same computer using VBA - Stack Overflow.

 

[ajayn]

There's a way to do this with less processing overhead and you can update the status bar without resetting the counter.
Have a look at Close an excel workbook opened by another user on the same computer using VBA - Stack Overflow.

Hello Teeroy,

Thank you so much for your response. However, I dont see which code updates the status bar here?

Thanks
Ajay N

 

[Teeroy]

Hi Ajay, I misread your original post. I thought that your issue was applying the statusbar changes, not needing code for them.

Try the following in a standard code module as an example. Run the countdown code.

Public Last_Time As Double

Sub Countdown()
Last_Time = Now()
Application.DisplayStatusBar = True
Update_Status_Bar

End Sub

Sub Update_Status_Bar()
Time_Used = DateDiff("n", Last_Time, Now())
Time_Left = 20 - Time_Used
Application.StatusBar = "Minutes remaining until closure due to inactivity: " & Time_Left
If Time_Used >= 0 And Time_Used < 20 Then
    Start_Time = Now() + TimeSerial(0, 1, 0)
    Application.OnTime Start_Time, "Update_Status_Bar"
Else
    MsgBox "Kick out now" 'replace with your kill code
End If
End Sub