excelファイルが意図せず起動

質問

下記を参考にして、起動時にタイマーを設定してexcelファイルを5分後に自動的に
保存・終了するようにしています。
http://okwave.jp/qa/q2911086.html

しかし実際5分を待たず、手動でそのexcelファイルを終了した場合、
後でそのexcelファイルが自動で起動して、そのまま終了しているようです。

この症状をなくしたい場合どのように、記述を加えればよいか教えていただけないでしょうか？

記述は下記です。

'標準プロシージャ
Public Operated As Boolean
Sub SetTimer()
Application.OnTime Now + TimeValue("00:05:00"), "CloseMe"
End Sub
Sub CloseMe()
If Operated Then
Operated = False
SetTimer
Exit Sub
End If
'ブックの上書き保存
ActiveWorkbook.Save
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True
' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit
' 本ブックをClose
ThisWorkbook.Close False
End Sub

'ワークブックプロシージャ
Private Sub Workbook_Open()
Operated = False
SetTimer
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Operated = True
End Sub
Private Sub Workbook_Deactivate()
Operated = True
End Sub
Private Sub Workbook_Activate()
Operated = True
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Operated = True
End Sub

回答No.1

WindFaller · ベストアンサー

こんにちは。

>実際5分を待たず、手動でそのexcelファイルを終了した場合、

直接の原因は、原本のコードは、おそらくSetOffTimer というプロシージャーがあったはずなのです。
それを設置しないといけなかったことですが、出されたコードに書き加えるよりも、全面的に書き直したほうがよいと思うのですが…。

OnTime の仕様は、バックグラウンドで動いているそうですから、自動で再起動するというよりも、Excelのマクロを実行しようとします。終了するときには、タイマー予約を切らないといけなかったのです。

そこで、私が考えたのは、
・何もしなければ、5分で終了する。
　--何もしないまま、改変されていた場合は、自動保存して終了する。（それでいいのかな？）
・他のブックで保存されていないものがあれば、タイマーは中止してしまいます。
・マウスを触ったら、次の5分のタイマーが更新します。ただし、少しでもマウスのトラブルがあると、更新されてしまいます。多少の調整は可能で、計算された、gMoPos の数値を、丸めればよいです。
・強制タイマー解除は、SetOffTimer を実行してください。

一応、これは32bitのみで、64bitではコードを書き換えないといけませんが、今回はサポートしません。
なお、今まであったマクロコードとは競合しますから、これを使う場合は、新規のブックか、すべて削除してから貼り付けてください。

'//
'標準モジュール
Option Explicit

Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
　　　　x As Long
　　　　y As Long
End Type
Public MoP As POINTAPI
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

Public gTime As Date
Public gLastTime As Date
Public gMoPos As Long
Sub SetTimer()
　gTime = Now + TimeValue("00:05:00")　'時間設定
　gLastTime = gTime + TimeValue("00:00:20")
　Application.OnTime Earliesttime:=gTime, _
　　　　　　　　　　Procedure:="CloseMe", _
　　　　　　　　　　Latesttime:=gLastTime, _
　　　　　　　　　　Schedule:=True
　GetCursorPos MoP
　gMoPos = MoP.x * MoP.y
　MessageBoxTimeoutA 0&, "タイマーが設定されました。" & vbCrLf & _
　"OKボタンは押さなくてよいです。", "タイマー設定", vbMsgBoxSetForeground, 0, 2000
End Sub
Sub SetOffTimer()
　On Error Resume Next
　Application.OnTime Earliesttime:=gTime, _
　　　　　　　　　　 Procedure:="CloseMe", _
　　　　　　　　　　 Latesttime:=gLastTime, _
　　　　　　　　　　 Schedule:=False　'SetOff には、LastTime を必ず入れる
　If Err.Number = 0 Then
　　MessageBoxTimeoutA 0&, "タイマー設定は解除されました", "タイマー解除", vbMsgBoxSetForeground, 0, 2000
　End If
　On Error GoTo 0
End Sub

Sub CloseMe()
　Dim wb As Workbook
　GetCursorPos MoP
　If gMoPos <> MoP.x * MoP.y Then
　　Call SetOffTimer '通常は働いていない
　　Call SetTimer
　　Exit Sub
　End If
　For Each wb In Workbooks
　　If wb.Name <> ThisWorkbook.Name Then
　　　If wb.Saved = False Then
　　　　'他のブックが開いて保存されていない場合は、タイマーは中止
　　　　MsgBox wb.Name & "は保存されていませんので、" _
　　　　& vbCrLf & "終了は中止します。", vbExclamation
　　　　Call SetOffTimer
　　　　Exit Sub
　　　End If
　　Else
　　　wb.Save '自ブックは、強制保存で終了
　　End If
　Next wb
　Application.Quit
　ThisWorkbook.Close False
End Sub

'ThisWorkbook モジュール
Private Sub Workbook_Open()
Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　Call SetOffTimer
End Sub

お礼

ご返事遅くなり申し訳ございません。
理解するのに、時間がかかってしまいました。
アドバイス頂いた内容を参考にして、なんとか対応できるようになりました。
ありがとうございました。