Excel计时器closures工作簿

不久之前，我发现（或发现）一些代码，如果用户将其打开（例如一整夜或一整天），则会在一段时间后自动closures共享工作簿。 代码运行良好，除了当它closures工作簿内驻留; 它也closures了所有的工作簿和Excel（以及没有Application.Quit）。 用户对此感到厌烦，有谁知道我怎样才能把它closures（Thisworkbook），而不是所有其他？

谢谢。

代码如下：

Option Explicit ' Declarations Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long Private mlngTimerID As Long ' start the timer Public Sub StartTimer(lngInterval As Long) mlngTimerID = SetTimer(0, 0, lngInterval, AddressOf TimerCallBack) End Sub ' when the timer goes off Public Sub TimerCallBack(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) ' stop the timer StopTimer ' don't save if read only If ThisWorkbook.ReadOnly = False Then ' save ThisWorkbook.Save End If ' exit without saving ThisWorkbook.Activate ThisWorkbook.Close False End Sub Public Sub StopTimer() KillTimer 0, mlngTimerID End Sub 'To use timer: 'To start the timer 'Call startTimer(1000)'1000 = 1 Second 'To stop timer 'Call stopTimer 

Answer 1

你有没有尝试过使用Excel的“OnTime”？

http://msdn.microsoft.com/en-us/library/aa195809(v=office.11​​).aspx

蒂姆

Answer 2

我知道这是一个较老的问题，但我想我会分享一个适合我的解决scheme。 打开时，工作簿将作为公用variables存储，以便在计时器到期时closures该工作簿。 如果工作簿在时间到期之前closures，则取消定时器。 如果计时器到期并且工作簿仍处于打开状态，则会自动保存并closures。

将以下代码插入“ThisWorkbook”

 'When the workbook is opened, call StartTimer() Public Sub Workbook_Open() Run "StartTimer" End Sub 'Detect if the workbook is closed Public Sub Workbook_BeforeClose(Cancel As Boolean) 'Cancel Saveclose Run "StopTimer" End Sub 

将代码插入到模块中

 'Global variables Public RunWhen As Double Public Const cRunIntervalSeconds = 300 ' seconds (set to 5 minutes) Public Const cRunWhat = "SaveClose" ' the name of the procedure to run Public GlobalBook As Workbook 'Start Timer using interval set in global variables Sub StartTimer() Set GlobalBook = ActiveWorkbook RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds) Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ Schedule:=True End Sub 'Stop the Timer whenever the workbook is closed prematurely Public Sub StopTimer() On Error Resume Next Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ Schedule:=False End Sub 'Close the workbook automatically once the Timer has expired Public Sub SaveClose() 'Time is up, workbook will save and close automatically Dim wb As Workbook For Each wb In Workbooks 'Check to see if workbook is still open If wb.Name = GlobalBook.Name Then Set wb = Application.Workbooks(GlobalBook.Name) 'Close workbook and Save Changes wb.Close SaveChanges:=True End If Next End Sub