OnTime の中断方法について

エクセル初心者でお恥ずかしい質問なのですが。
仕事で複数で同じファイルを編集しており（共有不可）、開きっぱなし防止のため、過去の別の方の質問の回答から、以下のものをThisWorkBookへ作成しました。１，２，３分後（実際は5,10,30分後）にメッセージが出る設定にしてますが、当ファイルを閉じても別のファイルが開いていると、メッセージが中断されず、指定時間になると出てしまいます。Workbook_BeforeCloseでは直前しか中断されないため、なにかいい方法はないか途方にくれております。そもそもこうじゃない等（おそらくOpenのあとのIfは3つまとめていいと思いますが）含め、ご教授いただきましたらよろしくお願いします。

以下
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Dim 警告時刻 As Date
Const 利用時間 As Integer = 1 '分+起動時刻:now

Private Sub Workbook_Open()

If Not ThisWorkbook.ReadOnly Then
警告時刻 = Now + 利用時間 * TimeValue("00:01:00") '分に変換
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意"
End If

If Not ThisWorkbook.ReadOnly Then
警告時刻 = Now + 利用時間 * TimeValue("00:02:00") '分に変換
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意2"
End If

If Not ThisWorkbook.ReadOnly Then
警告時刻 = Now + 利用時間 * TimeValue("00:03:00") '分に変換
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意3"
End If
End Sub

Private Sub 利用制限ご注意()
警告文 = "ファイル名　「" + ThisWorkbook.Name + "」" + vbCrLf
警告文 = 警告文 + "利用時間１分経過しました。" + vbCrLf
警告文 = 警告文 + "あせらずあわてず確実に"
MsgBox 警告文, vbCritical, "ファイルの閉じ忘れ確認"
End Sub

Private Sub 利用制限ご注意2()
警告文 = "ファイル名　「" + ThisWorkbook.Name + "」" + vbCrLf
警告文 = 警告文 + "利用時間２分を経過しました。" + vbCrLf
警告文 = 警告文 + "お時間が経過しております。"
MsgBox 警告文, vbCritical, "ファイルの閉じ忘れ確認"
End Sub

Private Sub 利用制限ご注意3()
警告文 = "ファイル名　「" + ThisWorkbook.Name + "」" + vbCrLf
警告文 = 警告文 + "利用時間３分を経過しました。" + vbCrLf
警告文 = 警告文 + "一度ファイルを閉じてください。"
MsgBox 警告文, vbCritical, "ファイルの閉じ忘れ確認"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime 警告時刻, "ThisWorkBook.利用制限ご注意3", Schedule:=False
End Sub

質問者からの補足コメント

• WindFallerさま、ありがとうございました。補足で登録するのですね。。。
  
  ＞解除方法
  ＞Application.OnTime .設定時間, マクロ名, ,False (引数の設定時間と、最後の引数をFalse にすると＞解除されます。)
  なんとなくはわかるのですが、今の私の作成したマクロで可能なんでしょうか？おそらくWindFallerさまが作成したマクロのように、１つの作業で３回のメッセージがでるようにすれば解除できますってことでしょうか？　すみません初心者の質問で。。。
  
  WindFallerさまに作成いただいたマクロでも、メッセージの表示時間を５分にし、５分毎にメッセージを出るように変更したら理想に近い大変便利なものとわかりました。もし私のが手間がかかるようでしたら使わせて頂ければと思いますのでよろしくお願いします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2018/01/03 08:57

No.1 回答者： WindFaller 回答日時： 2017/12/30 15:17

こんにちは。

今回、同様の質問がこれを含めて3つも出ていますね。

このご質問者(さんのコードを参考にしてみてください。
http://oshiete.goo.ne.jp/qa/10160168.html

この質問の元のコードは、かなり前のものですが、Application.OnTime ......,False とすることで解除するという内容なのです。ご質問のコードの場合は、

ループして、1つ終わったら、次のSub 利用制限ご注意 () 呼び出せばよいのですが、終了する時は残ってしまいますので、

解除方法
Application.OnTime .設定時間, マクロ名, ,False (引数の設定時間と、最後の引数をFalse にすると解除されます。)

今回、私は改めて見直してみました。気にいるかどうかは別ですが、それとは別案です。
MsgBox は、ユーザーが閉じなくても、自動で閉じますが、3分経つと、終了してください、と出ます。

なお、ThisWorkbook を使わなかったのは、元のマクロに、邪魔にならないようにしたまでです。
現行では、変数colSchedule　は、Collectionオブシェクトにしたのはあまり意味がありません。


'標準モジュール

#If Win64 Then
Private Declare PtrSafe Function MessageBoxEx Lib "user32" Alias _
　　"MessageBoxExA" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption _
　　As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long
#Else　'32bit版
Private Declare Function MessageBoxTimeoutA Lib "user32" (ByVal hwnd As Long, _
　　ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal _
　　wLanguageId As Long, ByVal dlliseconds As Long) As Long
#End If
Dim PassTime As Long
Dim colSchedule As Collection
Dim myTime As Date
Sub Auto_Open()
　PassTime = 0
　Set colSchedule = New Collection
　Call myTimeSchedule
End Sub
Private Sub myTimeSchedule()
'1分
myTime = Now + TimeSerial(0, 1,0)
PassTime = PassTime + 1
colSchedule.Add myTime
　'8'秒の待ち時間　
Application.OnTime myTime, "MyCaution", TimeSerial(0, 0, 8), True

End Sub
Private Sub myCaution()
Dim msgAry
Dim Ret As VbMsgBoxResult
Dim i As Long
　msgAry = Array("", "あせらずあわてず確実に", "お時間が経過しております。", "一度ファイルを閉じてください。", "時間超過!")
　If PassTime < 4 Then: i = PassTime: Else i = 4
　
　'自動的にメッセージが消えます。
　Ret = MessageBoxTimeoutA(Application.hwnd, "利用時間" & PassTime & "分経過しました。" & vbCrLf & _
　msgAry(i), "messagebox", vbMsgBoxSetForeground, 0, 3000)
　colSchedule.Remove 1
　If PassTime >= 3 Then
　　Ret = MsgBox("終了してください。", vbExclamation + vbOKCancel)
　　If Ret = vbOK Then
　　　ThisWorkbook.Close True
　　Else
　　　Call myTimeSchedule
　　End If
　Else
　　Call myTimeSchedule
　End If
End Sub
Sub Auto_Close()
If colSchedule.Count > 0 Then
　 Application.OnTime myTime, "MyCaution", , False
End If
End Sub

この回答へのお礼

WindFallerさま。ありがとうございました。ここへの質問が初めてでまた、素人の質問をしてしまいますが、
＞(引数の設定時間と、最後の引数をFalse にすると解除されます。)
とは、いろいろと調べながら考えてみましたが、理解が追いつきませんでした・・・
私のマクロから具体的にいただけるとうれしいですが。。。

WindFallerさまが作ったマクロで試してみました。すばらしいですが、開きっぱなし防止なのでメッセージが消えてしまうことがあわないこと、なにより素人の私には時間を変えたり手を加えるにはハードルが高いようです。わざわざいただいたのにすみません。

お礼日時：2017/12/31 23:40