自动关闭 Excel 工作簿并弹出警告答案

【问题标题】：Autoclose Excel Workbook with warning popup自动关闭 Excel 工作簿并弹出警告
【发布时间】：2017-01-09 08:30:59
【问题描述】：

我遇到了多个用户需要访问一个工作簿的情况（由于所有问题，希望避免使用“共享工作簿”选项）。我已确定可能的解决方案是让工作簿在 15 分钟不活动后自动关闭。

我还希望在 15 分钟后弹出一条消息，提醒用户除非他们单击“确定”按钮，否则工作簿将关闭。如果他们单击按钮，我希望计数器重新开始，理想情况下，如果他们不单击任何内容，工作簿将在再过 1 分钟后自动关闭。

我在网上找到了一些我用过的代码。工作簿在指定时间后成功关闭，但我不知道如何弹出消息框。非常感谢任何帮助，谢谢！

我使用的代码如下：

在模块 1 中：

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("0: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 ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub

在 ThisWorkbook 中：

Private Sub Workbook_Open()
    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
 End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer
End Sub

【问题讨论】：

MsgBox("超时？")?那不行吗？
再想一想，如果工作簿处于非活动状态，显示消息框将无济于事，因为它需要用户输入，而用户可能已经离开。 :-)
@dgorti 然后可以按预期关闭工作簿。
不要从“关闭”子程序中关闭工作簿，而是为此目的编写另一个子程序。在这个 sub 中添加一个 ontimer 事件（持续 1 分钟）并调用新的 sub 以真正关闭。您可以根据需要显示来自“关闭”子的消息。注意：不要使用“msgbox”来显示您的消息，因为它会抛出一个需要交互的对话框。而是创建一个简单的消息显示表单，可以在 1 分钟后卸载。完成工作后，我可以给你一个样品

标签： vba excel auto-close

【解决方案1】：

试试下面的ShutDown 程序：

Sub ShutDown()
    If CreateObject("WScript.Shell").PopUp("Close Excel?", 60, "Excel", vbOKCancel + vbQuestion + vbSystemModal) = vbCancel Then
        StopTimer
        SetTimer
        Exit Sub
    End If
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub

【讨论】：

【解决方案2】：

切勿与同事“共享”网络驱动器上的 Excel 文件。您将遇到各种问题，包括工作簿损坏和其他问题。试试这个脚本，在 n 分钟不活动后自动关闭您的 Excel 文件。

首先，将以下代码添加到标准宏模块。请注意，要添加三个例程：将停机时间调暗为日期

Sub SetTimer()
    DownTime = Now + TimeValue("01:00: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 ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub

需要将下一个例程（其中有四个）添加到 ThisWorkbook 对象。打开 VBA 编辑器并双击 Project Explorer 中的 ThisWorkbook 对象。在 Excel 打开的代码窗口中，放置以下例程：

Private Sub Workbook_Open()
    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer
End Sub

有关所有信息，请参阅此内容。

http://excelribbon.tips.net/T008192_Forcing_a_Workbook_to_Close_after_Inactivity.html

【讨论】：