ＶＢＡ＝一定時間エクセルの入力操作がない場合、自動的にそのブックを閉じたい

質問

共通でエクセルを使用していますが、時々エクセルを開いたまま外出したり、休憩したり
する方がおり、別な方がエクセルを開いて作業をしたいと思っても、どこかで開きぱなしのことが時々あります。

そんな時のために、エクセルに何も入力等がない一定時間経過したら、自動で保存して閉じる機能を持たせたいと考えています。例えば入力が５分以上なければ自動的に閉じるように・・・・

上書き保存は下記のＶＢＡで機能するのは確認済みですが、これに「５分後」等のタイムの設定をしたいのですが可能でしょうか？

可能の場合、どのようなＶＢＡになりますか？？

よろしくお願いします。

⇒
'ブックの上書き保存
ActiveWorkbook.Save
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True

' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit

' 本ブックをClose
ThisWorkbook.Close False

回答No.1

ham_kamo · ベストアンサー

何かオペレーションが行われたかを監視して、５分ごとにそれをチェックし、オペレーションがされなかったらブックを閉じるというマクロを組んでみました。（最後のオペレーションから５分間監視、ではなく、ブックを開いてから５分間隔でチェックするので、多少のタイムラグがあります）

しかし、「何もしなかったら」というのを検知する方法がわからなかったため、ちょっと強引ですが ThisWorkbook のイベントほとんど全てをを定義して、「何かした」というフラグを立てるという方法になっています。
そのため、ThisWorkbook のイベントで拾えない操作をしたときにも強制終了する可能性があります。

まず、標準モジュールに以下のマクロを貼り付けてください。
"00:05:00"という箇所が「５分」を定義しているところなので、時間間隔を調整したいときはそこをいじってください。

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

そして、ThisWorkbook に以下のマクロを貼り付けてください。

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

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
　Operated = True
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
　Operated = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
　Operated = True
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
　Operated = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
　Operated = True
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
　Operated = True
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
　Operated = True
End Sub

Private Sub Workbook_WindowResize(ByVal Wn As Window)
　Operated = True
End Sub

ご覧の通り、Workbook_Open()だけは初期設定をしていますが、その他は「何かイベントが発生したらフラグをTrueにする」の羅列です。

単にExcelのファイルを開いて、マウスのホイールでスクロールしながらあちこちシートを眺めているだけの場合など、セル操作や印刷などの操作がない場合にも強制終了されてしまうので、そこはご承知ください。

お礼

早速、ありがとうございます。
会社に行って試してみます。。。　m(__)m

眺めているだけの場合にも閉じられてしまうところが、
ちょっと・・・・検討してみます。。。。

回答No.5

Bickyon

VBAでは、ご希望の機能を完璧に実現するのは困難なような気がします。
どこかでチェック漏れが発生して大事な入力情報を失ってしまうことになるのではないでしょうか。

そこで提案ですが、メニューバーの「ツール」－「ブックの共有」を試してみてはどうでしょうか？

この機能はとても便利で、ブックを複数の人が開いて更新することができます。（私はチームの作業進捗管理には必ずこのブック共有を使っています）

自分がブックを更新したいときは、先ず保存ボタンを先にクリックします。そうすると自分がブックを開いた以降に他者が更新した内容が、画面に反映されますし、保存ボタンをクリックせずに他者が更新したセルを更新しようとすると警告してくれます。

更新する前に保存ボタンで表示内容を最新化するのと、入力が終わったら保存ボタンをクリックすることをルール徹底すれば、かなり便利な機能です。

難点としては共有状態のままでは、オートシェイプを更新したり、フィルタの条件を変更できない等ありますが、その際は一時的にブック共有を解除すれば大丈夫です。

一度お試しください。

回答No.4

ham_kamo

やっぱりデバッグで止まってしまっていますか…。

ステップ実行させていると書かれていたので私もタイマーを縮めてステップ実行させてみました。その結果、現象は再現しました。私の場合ではステップ実行している間に次のタイマーが来てしまい、ボタンの上にボタンが重ねられて、内部的に不整合が生じてエラーになることがわかりました。多分同じことが起きているのではないかと推測しています。

それで、多分今はブックを開いたときに、はじめからボタンが表示されている状態だと思います。それは前にデバッグして止まったときのボタンの残骸で、それを押すとエラーになります。もしそういう状態なら、ブックを開いてすぐにボタンの「縁」を右クリックして「切り取り」を行ってボタンを削除してください。正常な状態では、ブックを開いたときにはボタンは表示されません。

ひょっとしたら何枚もボタンの残骸が重なっているかもしれないので、上の操作で消してもまだボタンがある場合は、とりあえず全部消してみてください。その上でいったんブックを閉じて、再度開いてみてください。

それで、その後ステップ実行をするとまた同じ現象が発生してしまいます。なので、ステップ実行は行わずにタイマーを縮めてみて様子を見るなど、VBAの実際の実行時間とタイマーの関係が狂わないようにして、動作確認をしてみていただけますか？

回答No.3

ham_kamo

デバッグで止まってしまいましたか…。いろいろパターンを変えてテストしてみたのですが。

どういう条件の場合にエラーが出るかわかりますか？

とりあえず回避策として、

１．
　　Sub CloseMe()
　　If AlertButtonPushed Then Exit Sub
　　AlertButton.Delete　　　←←１．ここの部分
　　'ブックの上書き保存

の部分を、

１．
　　Sub CloseMe()
　　If AlertButtonPushed Then Exit Sub
　　If Not AlertButton Is Nothing Then
　　　　AlertButton.Delete
　　End If
　　'ブックの上書き保存

に変更して、

２．
Sub AlertButton_Click()
　AlertButtonPushed = True
　AlertButton.Delete　　　　　←←２．ここの部分
　SetTimer
End Sub

の部分を、

Sub AlertButton_Click()
　AlertButtonPushed = True
　AlertButton.Delete
　Set AlertButton = Nothing '←この行を追加
　SetTimer
End Sub

に変更して試していただけますか？

あと、ボタンの残骸がシートに残っていたら、右クリック＞切り取り　で消してください。

お礼

色々ありがとうございます。
ウーん、何度やっても下記の AlertButton.Delete　
のところでデバッグしてしまいます。。。。。。(-_-メ)

「AlertButton」をクリックしてもメッセージが消えませ～ん・・・・

⇒
Sub AlertButton_Click()
AlertButtonPushed = True
AlertButton.Delete
Set AlertButton = Nothing '←この行を追加
SetTimer
End　　　　　　　　←

回答No.2

ham_kamo

> 眺めているだけの場合にも閉じられてしまうところが、
> ちょっと・・・・検討してみます。。。。

やっぱりそうですよね。しかしながら、ただ眺めているだけでは何もオペレーションしてないのと同じなので、そうなってしまいます。マウスでどこかのセルをクリックしたり矢印キーでセルを移動するだけでいいのですが。

そうは言っても不便だと思ったので、ちょっと改良してみました。

何も操作せずに５分経つと、警告音とともに

　５分以上操作がなかったので
　３０秒後に終了します。
　操作を続行したいときは
　このボタンを押してください

と表示されたボタンをExcelの画面の中央に表示するようにしました。
そのボタンを押せばブックは閉じません。ボタンを押さずに３０秒経過すると、自動的にブックを閉じます。エクセルを最小化している場合は、最大化してボタンを表示するようにしています。

標準モジュールのマクロを以下に差し替えてみてください。
５分とか３０秒などを調節する場合は、マクロ中の
"00:05:00"や"00:00:30"の部分を変えてください。

Public Operated As Boolean
Public AlertButton As Object
Public AlertButtonPushed As Boolean

Sub SetTimer()
　Application.OnTime Now + TimeValue("00:05:00"), "ShowAlert"
End Sub

Sub CloseMe()

　If AlertButtonPushed Then Exit Sub

　AlertButton.Delete

　'ブックの上書き保存
　ActiveWorkbook.Save
　' 保存確認を避けるため、保存済みにする
　ThisWorkbook.Saved = True

　' 他にブックが開いていなければ、Excelを終了する
　If Workbooks.Count <= 1 Then Application.Quit

　' 本ブックをClose
　ThisWorkbook.Close False
End Sub

Sub ShowAlert()
　Dim BtnLeft As Double, BtnTop As Double
　Dim BtnWidth As Double, BtnHeight As Double

　If Operated Then
　　Operated = False
　　SetTimer
　　Exit Sub
　End If

　If Application.WindowState = xlMinimized Then
　　Application.WindowState = xlMaximized
　End If
　AppActivate "Microsoft Excel - " & ThisWorkbook.Name

　AlertButtonPushed = False
　BtnWidth = 150
　BtnHeight = 100
　BtnLeft = ActiveWindow.Width / 2 - BtnWidth / 2
　BtnTop = ActiveWindow.Height / 2 - BtnHeight
　ActiveSheet.Buttons.Add BtnLeft, BtnTop, BtnWidth, BtnHeight
　Set AlertButton = ActiveSheet.Buttons(ActiveSheet.Buttons.Count)
　AlertButton.OnAction = "AlertButton_Click"
　AlertButton.Characters.Text = _
　"５分以上操作がなかったので" & vbCrLf & _
　"３０秒後に終了します。" & vbCrLf & _
　"操作を続行したいときは" & vbCrLf & _
　"このボタンを押してください"
　With AlertButton.Characters.Font
　　.Name = "ＭＳ Ｐゴシック"
　　.FontStyle = "標準"
　　.Size = 9
　End With
　Beep

　Application.OnTime Now + TimeValue("00:00:30"), "CloseMe"
End Sub

Sub AlertButton_Click()
　AlertButtonPushed = True
　AlertButton.Delete
　SetTimer
End Sub

お礼

色々恐縮です。
早速ですが、標準モジュールのマクロを以下に差し替えてみまして
「ステップイン」を実行してみましたが、下記の２ケ所でデバッグが
表示されてしまいます・・・・・
スミマセンがよろしくご教授お願いします。

１．
　　Sub CloseMe()
　　If AlertButtonPushed Then Exit Sub
　　AlertButton.Delete　　　←←１．ここの部分
　　'ブックの上書き保存

２．
　Sub AlertButton_Click()
AlertButtonPushed = True
AlertButton.Delete　　　　　←←２．ここの部分
SetTimer
End Sub