| |
こんにちは。
「更新されていなければ、自動閉じる」処理を行おうとしているのですが、
BeforeSaveイベントからOnTimeを再セットできずに悩んでいます。
Open→Reset_OnTime→5秒後にBook_Chk→Book_ChkのSaveでBeforeSaveイベント
→Reset_OnTime→5秒後にBook_Chk→・・・・
となる予定だったのですがReset_OnTimeは実行されるのですが、
次回のスケジュールとステータスバーの更新がされません。
手動で上書き保存するとスケジュールとタスクバーの更新は、実行されます。
Book_Chk()内の*2の箇所で呼び出せば動作は問題ないのですが、
「なぜダメなのか？」知りたいです。
一通り、情報はチェックしたつもりなのですが、原因がわかりませんでした。
よろしくお願いします。
'標準モジュール
Public T As Date 'チェック実行時刻
Sub Reset_OnTime()
MsgBox "Reset_OnTime" '*1 Reset_OnTimeの実行チェック用
Const Intarval As String = "00:00:05" 'チェック間隔 テスト用に5秒間隔
On Error Resume Next
'次回チェックの削除
Application.OnTime T, "Book_Chk", , False
'次回チェックの再設定
T = Now() + TimeValue(Intarval)
Application.OnTime T, "Book_Chk"
Application.StatusBar = "次回チェック:" & T
On Error GoTo 0
End Sub
Sub Book_Chk()
Dim WSH As Object 'WScript.Shell
Dim Lmt As Date 'リミット時刻
Dim Ans As Variant 'Popupの回答
Dim Cnt As Integer 'Popupの表示時間（秒）
Cnt = 3
Set WSH = CreateObject("WScript.Shell")
'更新されているかチェック
If ThisWorkbook.Saved = True Then
Lmt = T + TimeSerial(0, 0, Cnt) 'Lmtにチェック時間+Popup時間をセット
Ans = WSH.Popup("未更新です。" & vbCr & Format(Lmt, "hh:mm:ss") & _
"に自動終了します｡" & vbCr & "更新を続けますか？", Cnt, , vbQuestion)
If Ans <> 1 Then
Set WSH = Nothing
ThisWorkbook.Close True
End If
End If
ThisWorkbook.Save '現在までの更新を上書き保存
Set WSH = Nothing
'Call Reset_OnTime '*2 BeforeSaveで実行されるので必要ないはず・・
End Sub
'ThisWorkBookモジュール
Private Sub Workbook_Open()
'次回チェックの設定
Call Reset_OnTime
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'次回チェックの再設定
Call Reset_OnTime
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'次回チェック分のOnTimeを解除
On Error Resume Next
Application.OnTime T, "Book_Chk", , False
On Error GoTo 0
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
