Excel Macro заставляет файл повторно открывать

Question

У меня есть странная проблема с макросом, который я собрал для работы.

Backstory, я в основном разработал макрос, чтобы закрыть защищенные книги после того, как он оставлен открытым после X количества времени. его общий документ, и когда люди открывают его, они часто забывают закрыть документ, блокируя его, чтобы другие не могли его использовать.

Итак, я создал кусочки других макросов, чтобы создать таймер.

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 

в 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 

По большей части она работает. Но я бы предпочел исключить «Application.Quit». Проблема, с которой я столкнулась, заключается в том, что, когда я удаляю эту строку, рабочая книга мгновенно открывается снова после ее закрытия вручную или пытается выйти из excel вручную.

Я предполагаю, что это может иметь отношение к постоянному изменению значения 1 ячейки (далеко, так что никто ее не видит) и выхода без сохранения.

Может ли кто-нибудь мне помочь? Спасибо

Answer 1

Добавить глобальную переменную для хранения значения времени последней запланированная OnTime() и настроить сабвуфер таймера:

Dim lastTimer As Variant 

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

Затем добавьте к этому событию Workbook_BeforeClose:

Application.OnTime lastTimer, "CheckStatus", , False 

Это аннулирует последний запланированный вызов Application.OnTime().

Answer 2

Может быть у вас есть опечатка ?:

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

Answer 3

Вы знаете, вы можете дать Excel файл общего статуса, так что она может быть доступна Simultaniously несколько пользователей?

смотри, например: http://office.microsoft.com/en-in/excel-help/share-a-workbook-HP005202595.aspx