Excel Application.OnTime宏致目标工作簿关闭后重开循环问题求助

我有一个带宏的Excel工作簿，实现了闲置15分钟后自动关闭的功能。但当同时打开其他Excel工作簿（xlsx/xlsm格式）时，目标工作簿执行关闭后会自动重新打开，甚至陷入循环，直到关闭所有工作簿退出Excel。仅当该带宏工作簿是唯一打开的文件时功能正常。

需求：闲置时自动保存并仅关闭目标工作簿，不影响其他工作簿，关闭时要有效停止Application.OnTime事件。

原代码 #

ThisWorkbook中的代码 #

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub

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

    Call StopTimer
    Call SetTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call StopTimer
    Call SetTimer
End Sub

单独模块中的代码 #

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:15:00")
    Application.OnTime EarliestTime:=DownTime, _
        Procedure:="ShutDown", Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
        Procedure:="ShutDown", Schedule:=False
End Sub

Sub ShutDown()
    Application.DisplayAlerts = False
    With Workbooks("Customer Complaint Tracker.xlsm")
        .Saved = True
        .Close
    End With
End Sub

问题根源 #

Application.OnTime是应用程序级的调度事件，而非绑定到单个工作簿。当目标工作簿关闭后，已调度的ShutDown过程仍会触发——由于该过程属于目标工作簿的宏，Excel会自动重新打开该工作簿来执行代码，进而再次触发关闭、重新打开的循环。另外，硬编码工作簿名称、未在关闭前彻底终止定时器，也会加剧问题。

调整后的代码及说明 #

核心修改点 #

• 将定时器调度的过程明确绑定到当前工作簿，避免应用级混乱
• 关闭工作簿前先彻底取消定时器
• 使用ThisWorkbook替代硬编码的工作簿名称，确保只操作目标文件
• 改为真正保存工作簿，而非仅设置Saved=True

修改后的ThisWorkbook代码 #

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    StopTimer
    SetTimer
End Sub

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

' 可选：切换回该工作簿时重启计时
Private Sub Workbook_Activate()
    SetTimer
End Sub

修改后的模块代码（建议命名为IdleTimerModule） #

Public DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:15:00")
    ' 明确指定过程所属的工作簿，防止应用级调度混淆
    Application.OnTime EarliestTime:=DownTime, _
        Procedure:=ThisWorkbook.Name & "!ShutDown", Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    ' 取消时必须匹配调度时的完整过程路径
    Application.OnTime EarliestTime:=DownTime, _
        Procedure:=ThisWorkbook.Name & "!ShutDown", Schedule:=False
    On Error GoTo 0 ' 恢复默认错误处理
End Sub

Sub ShutDown()
    ' 先取消定时器，彻底终止后续触发
    StopTimer
    
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Save ' 实际保存文件，确保数据不丢失
        .Close SaveChanges:=False ' 已保存，无需再次提示
    End With
    Application.DisplayAlerts = True ' 恢复Excel默认提示设置
End Sub

额外注意事项 #

• 确保模块名称不与过程名重复，避免宏执行错误
• 如果工作簿重命名，代码无需修改（因为用了ThisWorkbook）
• 若需要调整闲置时长，修改SetTimer中的TimeValue("00:15:00")即可

内容的提问来源于stack exchange，提问作者Kemidan2014