エクセルでブックを閉じたときマクロを終了させるには vol.2

質問

http://oshiete1.goo.ne.jp/kotaeru.php3?q=2003769

上記にて、マクロが一度完成していたのですが、以下のような苦情が出てきました。

1.エクセルの右上にある、「×」マークを押した場合に「保存しますか？」と聞かれてくるので、「はい」を押しても内容が保存されていない。
2.「×」マークを押したとき、「はい」「いいえ」のほかに「キャンセル」の表示がほしい。
3.エクセルデータを「読み取り専用」で開いていても10分後に警告文がでてくる。

上記を解消することは、可能でしょうか？もし可能であればサンプルをお願いします。

回答No.2

1050 円（@1050YEN） · ベストアンサー

エラーの原因は、SetOnTimeが走っていないのにResetOntimeを実行するタイミングがあるからだと思います。
どのタイミングで発生する症状かは、環境に依存するのかな？
ちなみに私のところでは出ませんでした。

なので、汎用性を持った処理に改造をしましょう。

もう少し、自力で解決をする努力をしましょうね。

Option Explicit

Private 開始時刻 As Date
Private 警告時刻 As Date
Private m_bln警告モード As Boolean
'利用制限時間については定数で宣言するよりも、
'設定専用シートを用意し読み込むか、
'又はIniファイルなどから読み込むようにすると
'汎用性を持たせることが出来るでしょう。
Private Const 利用制限時間 As Integer = 1 '分

Private Sub Workbook_Open()
　　開始時刻 = Now
　　Call SetOnTime
End Sub

Private Sub 利用制限ご注意()
　　Dim 警告文 As String
　　警告文 = vbNullString
　　警告文 = 警告文 & ThisWorkbook.Name & "を開いて" & CStr(DateDiff("n", 開始時刻, 警告時刻)) & "分経過しました。" & vbCrLf
　　警告文 = 警告文 & "使用しない場合は終了してください。" & vbCrLf
　　警告文 = 警告文 & "継続して使用しますか？"
　　If MsgBox(警告文, vbYesNo Or vbExclamation, "共有ファイルの利用について") = vbYes Then
　　　　Call SetOnTime
　　Exit Sub
　　End If
　　ThisWorkbook.Close
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　'リセット処理を行う
　　Call ResetOntime

　　'変更が無ければ、何もしないで終了
　　If ThisWorkbook.Saved Then
　　　　GoTo PGMEND
　　End If

　　'読み取り専用のため、変更は破棄して良いかの問い合わせ
　　If ThisWorkbook.ReadOnly Then
　　　　Cancel = (vbCancel = MsgBox("読み取り専用のため、変更は破棄されます。よろしいですか?", vbOKCancel Or vbExclamation))
　　　　If Not Cancel Then
　　　　　　'処理を継続するのであれば、変更状態を無効にする
　　　　　　ThisWorkbook.Saved = True
　　　　End If
　　　　GoTo PGMEND
　　End If

　　'上記に該当しない場合、終了の処理方法を問い合わせ
　　Select Case MsgBox("'" & ThisWorkbook.Name & "'への変更を保存しますか？", vbYesNoCancel Or vbExclamation)
　　　　Case vbYes
　　　　　　'保存する
　　　　　　ThisWorkbook.Save
　　　　Case vbNo
　　　　　　'変更状態を無効にする
　　　　　　ThisWorkbook.Saved = True
　　　　Case vbCancel
　　　　　　'終了をキャンセル
　　　　　　Cancel = True
　　End Select

PGMEND:
　　'終了処理がキャンセルされた場合
　　If Cancel Then
　　　　'今から、タイマーを起動する
　　　　Call SetOnTime
　　End If
End Sub

Private Sub SetOnTime()
　　If Not ThisWorkbook.ReadOnly Then
　　　　警告時刻 = DateAdd("n", 利用制限時間, Now) '現在時刻＋利用制限時間
　　　　Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意"
　　　　m_bln警告モード = True
　　End If
End Sub

Private Sub ResetOntime()
　　If m_bln警告モード Then
　　　　Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意", Schedule:=False
　　　　m_bln警告モード = False
　　End If
End Sub

回答No.1

1050 円（@1050YEN）

Workbook_BeforeClose関数を変更したらいいです。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　'リセット処理を行う
　　Call ResetOntime

　　'変更が無ければ、何もしないで終了
　　If ThisWorkbook.Saved Then
　　　　GoTo PGMEND
　　End If

　　'読み取り専用のため、変更は破棄して良いかの問い合わせ
　　If ThisWorkbook.ReadOnly Then
　　　　Cancel = (vbCancel = MsgBox("読み取り専用のため、変更は破棄されます。よろしいですか?", vbOKCancel Or vbExclamation))
　　　　GoTo PGMEND
　　End If

　　'上記に該当しない場合、終了の処理方法を問い合わせ
　　Select Case MsgBox("'" & ThisWorkbook.Name & "'への変更を保存しますか？", vbYesNoCancel Or vbExclamation)
　　　　Case vbYes
　　　　　　'保存する
　　　　　　ThisWorkbook.Save
　　　　Case vbNo
　　　　　　'変更状態を無効にする
　　　　　　ThisWorkbook.Saved = True
　　　　Case vbCancel
　　　　　　'終了をキャンセル
　　　　　　Cancel = True
　　End Select

PGMEND:
　　'終了処理がキャンセルされた場合
　　If Cancel Then
　　　　'今から、タイマーを起動する
　　　　Call SetOnTime
　　End If
End Sub

補足

Private 開始時刻 As Date
Private 警告時刻 As Date
'利用制限時間については定数で宣言するよりも、
'設定専用シートを用意し読み込むか、
'又はIniファイルなどから読み込むようにすると
'汎用性を持たせることが出来るでしょう。
Private Const 利用制限時間 As Integer = 1 '分

Private Sub Workbook_Open()
開始時刻 = Now
Call SetOnTime
End Sub

Private Sub 利用制限ご注意()
Dim 警告文 As String
警告文 = vbNullString
警告文 = 警告文 & ThisWorkbook.Name & "を開いて" & CStr(DateDiff("n", 開始時刻, 警告時刻)) & "分経過しました。" & vbCrLf
警告文 = 警告文 & "使用しない場合は終了してください。" & vbCrLf
警告文 = 警告文 & "継続して使用しますか？"
If MsgBox(警告文, vbYesNo Or vbExclamation, "共有ファイルの利用について") = vbYes Then
Call SetOnTime
Exit Sub
End If
ThisWorkbook.Close
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'リセット処理を行う
Call ResetOntime

'変更が無ければ、何もしないで終了
If ThisWorkbook.Saved Then
GoTo PGMEND
End If

'読み取り専用のため、変更は破棄して良いかの問い合わせ
If ThisWorkbook.ReadOnly Then
Cancel = (vbCancel = MsgBox("読み取り専用のため、変更は破棄されます。よろしいですか?", vbOKCancel Or vbExclamation))
GoTo PGMEND
End If

'上記に該当しない場合、終了の処理方法を問い合わせ
Select Case MsgBox("'" & ThisWorkbook.Name & "'への変更を保存しますか？", vbYesNoCancel Or vbExclamation)
Case vbYes
'保存する
ThisWorkbook.Save
Case vbNo
'変更状態を無効にする
ThisWorkbook.Saved = True
Case vbCancel
'終了をキャンセル
Cancel = True
End Select

PGMEND:
'終了処理がキャンセルされた場合
If Cancel Then
'今から、タイマーを起動する
Call SetOnTime
End If
End Sub

Private Sub SetOnTime()
If Not ThisWorkbook.ReadOnly Then
警告時刻 = DateAdd("n", 利用制限時間, Now) '現在時刻＋利用制限時間
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意"
End If
End Sub

Private Sub ResetOntime()
Application.OnTime 警告時刻, "ThisWorkbook.利用制限ご注意", Schedule:=False
End Sub

------------------------------------------------

このマクロを実行した場合に、エクセル右上の「×」をクリックすると、「実行時エラー'11004'：　'OnTime'メソッドは失敗しました:'_Application'オブジェクトと表示されてしまいます。その他の動作は問題ないと思われます。指導よろしくお願いします。