Autoclose Excel Workbook с предупреждающим всплывающим окном

Question

У меня возникла ситуация, когда нескольким пользователям нужно будет получить доступ к рабочей книге (вы должны избегать использования опции «Совместное использование книг» из-за всех проблем). Я решил, что возможное решение этого - заставить книгу автоматически закрыться после 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 

Answer 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 

Answer 2

Никогда не делите «файлы Excel на сетевом диске с сотрудниками». Вы столкнетесь со всеми проблемами, в том числе с коррупцией в книгах, и другими вещами. Попробуйте этот скрипт, чтобы автоматически закрыть ваши файлы Excel после n-минут бездействия.

Чтобы начать, добавьте следующий код в стандартный макромодуль. Обратите внимание, что есть три подпрограммы, которые будут добавлены: Dim простои Дата

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 и дважды щелкните объект ThisWorkbook в Project Explorer. В окне кода, который открывается 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