Excel宏导致文件重新打开

Question

I have an odd issue with a macro I put together for work.

Backstory, I basically designed a macro to close a protected-workbooks after being left opened after X amount of time. its a shared document, and when people open it, they often forget to close the document, locking it up so others can't use it.

So I took bits and pieces of other macros to create a timer.

Sub Start_Timer()
'BASIC UP COUNTER
Application.OnTime Now() + TimeValue("00:00:01"), "CheckStatus"
End Sub


Sub CheckStatus()
Dim ws As Worksheet
For Each ws In Worksheets

If ws.Range("IV1").Value > 60 Then
'IF IDLE LONGER THAN VALUE ABOVE, RUN THE FOLLOWING
Application.DisplayAlerts = False 'WORKS TO DISABLE ALERT PROMPT
ThisWorkbook.Close (False) 'CLOSE FILE WITHOUT SAVING
Application.Quit
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
End Sub    

Else
'ADD 1 TO COUNTER
ws.Range("IV1").Value = ws.Range("IV1").Value + 1
End If
Next
Start_Timer
End Sub

in ThisWorkbook

Private Sub Workbook_Open()
Dim ws As Worksheet
MsgBox ("This Worksheet has a 15 min timer")

Start_Timer
For Each ws In Worksheets
'Columns("IV:IV").Hidden = True

ws.Range("IV1").Value = 1
Next
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim ws As Worksheet
For Each ws In Worksheets
ts.Range("IV1").Value = 1
Next
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False 'WORKS TO DISABLE ALERT PROMPT
ThisWorkbook.Close (False) 'CLOSE FILE WITHOUT SAVING
Application.Quit
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
End Sub

For the most part it works. But, I'd rather eliminate the like "Application.Quit". The problem I am having is that when I eliminate that line, the Workbook instantly re-opens after closing it manually, or trying to quit excel manually.

I assume it might have to do with constantly changing the value of 1 cell (far off so no one sees it) and exiting without saving.

Can anyone help me? Thanks

Answer 1

Maybe you have a typo?:

Dim ws As Worksheet
For Each ts In Worksheets
         ^ws ??
If ws.Range("IV1").Value > 60 Then

Answer 2

You know you can give an Excel file a shared status, so that it can be accessed simultaniously by multiple users?

see for example: http://office.microsoft.com/en-in/excel-help/share-a-workbook-HP005202595.aspx

Answer 3

Add a global variable to store the last scheduled OnTime() time value and adjust your timer sub:

Dim lastTimer As Variant

Sub Start_Timer()
    'BASIC UP COUNTER
    lastTimer = Now() + TimeValue("00:00:01")
    Application.OnTime lastTimer, "CheckStatus"
End Sub

Then add this to the Workbook_BeforeClose event:

Application.OnTime lastTimer, "CheckStatus", , False

This will cancel the last scheduled call by Application.OnTime().