共享Excel工作簿无活动计时器异常问题求助

• 初始需求：共享Excel工作簿添加无活动计时器——2小时无操作弹出提示，10分钟未响应则保存并关闭，但原代码存在提示超时后无法关闭工作簿的问题。
• 调整后需求：监控「Data_Entry」工作表，2小时无修改自动关闭工作簿，修改时重置计时器，但出现提前关闭（5分钟内触发）的异常。

共享工作簿对VBA操作有特殊限制，需针对性调整逻辑：

一、修复“提示超时后无法关闭共享工作簿”问题 #

共享模式下直接调用ThisWorkbook.Close可能因锁定或权限失败，需优化关闭逻辑，同时避免计时器叠加：

' 模块级变量存储计时器触发时间
Dim closeTimer As Double

' 初始化/重置无活动计时器（2小时）
Sub StartInactivityTimer()
    ' 先取消之前的计时器，防止多个计时器叠加触发
    On Error Resume Next
    Application.OnTime closeTimer, "CheckInactivity", , False
    On Error GoTo 0
    
    ' 设置新的2小时计时器
    closeTimer = Now + TimeValue("2:00:00")
    Application.OnTime closeTimer, "CheckInactivity"
End Sub

' 检查无活动状态并弹出提示
Sub CheckInactivity()
    Dim response As VbMsgBoxResult
    response = MsgBox("已2小时无操作，是否继续使用？", vbYesNo + vbQuestion, "无活动提醒")
    
    If response = vbNo Then
        CloseSharedWorkbook
    Else
        ' 用户响应，重置计时器
        StartInactivityTimer
    End If
End Sub

' 共享工作簿专用关闭方法
Sub CloseSharedWorkbook()
    On Error Resume Next
    ' 先保存工作簿
    ThisWorkbook.Save
    
    ' 若需强制关闭，先获取独占权限（需用户有对应权限）
    If ThisWorkbook.MultiUserEditing Then
        ThisWorkbook.ExclusiveAccess
    End If
    
    ' 关闭工作簿
    ThisWorkbook.Activate
    Application.DisplayAlerts = False
    ThisWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

' 触发计时器重置的事件（工作表激活、单元格修改时）
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    StartInactivityTimer
End Sub

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

' 工作簿打开时初始化计时器
Private Sub Workbook_Open()
    StartInactivityTimer
End Sub

二、修复“监控Data_Entry修改后提前关闭”的异常 #

提前关闭的核心原因是计时器叠加或非用户操作触发重置失效，解决方案如下：

' 模块级变量存储修改监控计时器触发时间
Dim modifyTimer As Double

' 初始化/重置修改监控计时器（2小时）
Sub StartModifyTimer()
    ' 取消旧计时器，避免叠加
    On Error Resume Next
    Application.OnTime modifyTimer, "CloseIfNoModify", , False
    On Error GoTo 0
    
    modifyTimer = Now + TimeValue("2:00:00")
    Application.OnTime modifyTimer, "CloseIfNoModify"
End Sub

' 无修改时执行关闭
Sub CloseIfNoModify()
    CloseSharedWorkbook
End Sub

' 仅在用户手动修改Data_Entry表时重置计时器
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ' 排除VBA/公式触发的自动修改，只响应用户手动操作
    If Sh.Name = "Data_Entry" And Application.UserControl Then
        StartModifyTimer
    End If
End Sub

' 工作簿打开时初始化计时器
Private Sub Workbook_Open()
    StartModifyTimer
End Sub

' 复用之前的共享工作簿关闭方法
Sub CloseSharedWorkbook()
    On Error Resume Next
    ThisWorkbook.Save
    
    If ThisWorkbook.MultiUserEditing Then
        ThisWorkbook.ExclusiveAccess
    End If
    
    ThisWorkbook.Activate
    Application.DisplayAlerts = False
    ThisWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

关键注意事项 #

• 计时器变量必须声明为模块级，否则会丢失引用无法取消旧计时器；
• 共享工作簿下，ExclusiveAccess方法需要用户有独占权限，若无需强制关闭可跳过此步骤；
• Application.UserControl用于区分用户手动操作与VBA/公式自动修改，避免计时器被无效触发。

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