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

Question

http://oshiete1.goo.ne.jp/kotaeru.php3?q=2003769

上記にて、マクロが一度完成していたのですが、以下のような苦情が出てきました。

1.エクセルの右上にある、「×」マークを押した場合に「保存しますか？」と聞かれてくるので、「はい」を押しても内容が保存されていない。
2.「×」マークを押したとき、「はい」「いいえ」のほかに「キャンセル」の表示がほしい。
3.エクセルデータを「読み取り専用」で開いていても10分後に警告文がでてくる。

上記を解消することは、可能でしょうか？もし可能であればサンプルをお願いします。

1050YEN · Accepted Answer

エラーの原因は、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

1050YEN · Answer

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

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

エラーの原因は、SetOnTimeが走っていないのにResetOntimeを実行するタイミングがあるからだと思います。

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

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング