自動閉じる閉じるポップアップメッセージを含むワークブック

Question

5分以内にブックを自動的に閉じることができるマクロを作成しようとしていますが、4分30秒でポップアップ通知メッセージが表示されます。ユーザーが[OK]ボタンをクリックしないと、メッセージボックスが10秒後に自動的に閉じられます。私は、メッセージボックスが10秒以内に閉じることができない時点で立ち往生しています。私のコードのほとんどはインターネットからコピーされています。以下は私のコードです：ブックのページで

：モジュールで

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 

Dim downtime As Date 

Sub settimer() 

    downtime = Now + TimeValue("00:01:00") 

    alerttime = downtime - TimeValue("00:00:50") 

    Application.OnTime Earliesttime:=alerttime, _ 
    procedure:="alertuser", schedule:=True 

    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 = True 

    With ThisWorkbook 

     .Save = True 

     .Close 

    End With 

End Sub 

Sub alertuser() 

    Dim wsshell 

    Dim intText As Integer 

    Set wsshell = CreateObject("WScript.Shell") 

    intText = wsshell.Popup("log sheet will be closed in 30 seconds if there are no more inputs", 10, "reminder") 

    Set wsshell = Nothing 

End Sub 

Answer 1

あなたは完全にあなたのプロシージャ名を修飾する必要があります。問題の手技を見つけることができません。タイプミスがあり、グローバル変数alerttimeがない部分もあります。これを試してみてください：私はフォームを変更し、[プロパティ]ウィンドウで

：

Public downtime As Date 
Public alerttime As Date 

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  

Sub settimer() 

    downtime = Now + TimeValue("00:01:00") 

    alerttime = downtime - TimeValue("00:00:50") 

    'fully qualify your procedure name here and the procedure will run 
    Application.OnTime Earliesttime:=alerttime, _ 
    procedure:="WorkbookName.xlsm!ThisWorkbook.alertuser", schedule:=True 

    'and here... also typo was here in downtime 
    Application.OnTime Earliesttime:=downtime, _ 
    procedure:="WorkbookName.xlsm!ThisWorkbook.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 = True 

    With ThisWorkbook 

     .Save = True 

     .Close 

    End With 

End Sub 

Sub alertuser() 

    Dim wsshell 

    Dim intText As Integer 

    Set wsshell = CreateObject("WScript.Shell") 

    intText = wsshell.Popup("log sheet will be closed in 30 seconds if there are no more inputs", 10, "reminder") 

    Set wsshell = Nothing 

End Sub 

Answer 2

あなたはこのような内容です（これはあなたのVBAエディタでプロジェクトにInsert）ユーザーフォームを使用することができます名前をformReminderに設定すると、他のモジュールで参照しやすくなります。その後、ユーザーフォームのコードウィンドウに、私は入れ：

Private Running As Boolean 

Private Sub CommandButton1_Click() 
    Running = False 
End Sub 

Private Sub UserForm_Activate() 
    Dim start As Single 
    start = Timer 
    Running = True 
    Do While Running And Timer < start + 10 
     DoEvents 
    Loop 
    Unload Me 
End Sub 

Private Sub UserForm_Click() 
    Running = False 
End Sub 

を使用すると、コード内のどこか他のラインformReminder.Showを実行すると（例えば - あなたがポップアップを作成する場所の代わりに）フォームが10秒間表示し、表示されます（またはそれ以上の場所をクリックした場合は少なくなります）、その後消えます。

それは次のようになります。表示中：

Answer 3

おかげで、あなたの答えのためJohn Colemanを。それは私が長い間欲しかった解決策に私を導いた。私はあなたのコードを取って、メッセージのパラメータと待機する秒数を受け入れるジェネリック関数に変換しました。

Sub MsgBoxTimerTest() 
' Test the Message box with a timer form 
Dim vReturn As Variant 
vReturn = MsgBoxTimerCall("MessageBox that Dissappears after n Seconds", "Hello World!", 3) 
End Sub 
' ************************************************************************** 

Function MsgBoxTimerCall(strCaption As String, strMessage As String, intSeconds As Integer) 
' Show a messagebox for a while 
' https://stackoverflow.com/questions/37281840/automatic-close-excel-workbook-with-a-pop-up-message 
' 2016-06-21 
TimerSeconds = intSeconds 
msgBoxTimerForm.Caption = strCaption 
msgBoxTimerForm.TextBox1.Value = strMessage 
msgBoxTimerForm.Show 
End Function 
' ************************************************************************** 

' ************************************************************************** 
Insert this code in the form 
' ************************************************************************** 
Private Running As Boolean 

Private Sub CommandButton1_Click() 
    MsgBox "Yo!" 
    Running = False 
End Sub 

Private Sub UserForm_Activate() 
    Dim start As Single 
    start = Timer 
    Running = True 
    Do While Running And Timer < start + TimerSeconds 
     DoEvents 
    Loop 
    Unload Me 
End Sub 

Private Sub UserForm_Click() 
    Running = False 
End Sub