ファイルの自動保存終了が出来るでしょうか。

質問

共有ファイルを操作している人が急な事情で席をはずし長時間そのままになってしまうことがよくあり困っています。
このような共有ファイルに、一定時間が経過すれば、自動的に保存終了するような機能やマクロの設定などは出来るでしょうか。
例えば２０分無操作となれば自動的に保存終了を行う機能や設定などです。
どなたか教えてください。よろしくお願いいたします。

回答No.2

yokomaya · ベストアンサー

ケアレスミスでした。
----------------------------------------------------

Option Explicit
Const 自動保存時間 = 10
Private Sub Workbook_Open()
Application.OnTime Now() + TimeSerial(0, 自動保存時間, 0), "Thisworkbook.自動保存"
End Sub

Public Sub 自動保存()
Application.EnableEvents = False
If ThisWorkbook.Saved = True Then
ThisWorkbook.Close
Else
ThisWorkbook.Save
Application.OnTime Now() + TimeSerial(0, 自動保存時間, 0), "Thisworkbook.自動保存"
End If
Application.EnableEvents = True
End Sub

回答No.4

yokomaya

ご質問が２０分でしたので最初の１０分後に自動保存次の自動保存までに変更がなければ閉じる仕様です。ですから１５分は考えておりません。
仕様上、偶数になってしまいますので。
＞入力の途中でも自動終了となる方法
可能ですがちょっと手間なんです。別ブックで監視する必要があります。
ですからこのブックの中ではなく別のブックを開いてそちらから監視するということになります。

お礼

早々のご教示、また再度のご回答、ありがとうございます。
早速活用させていただくことにします。
また、いろいろと勉強もさせていただきました。
本当にありがとうございました。
また、よろしくお願いいたします。

回答No.3

Wendy02

こんにちは。

作ってみましたが、マクロの構造は少し複雑になっています。

入力してから、20分なり設定しても、強制自動終了ではうまくありません。以下のマクロは、入力しないままにしておくと、やがて、終了します。

この設定は、「このまま終了しますか。」というメッセージが出て、いいえ/No を押さないと、そのまま終了してしまいます。

入力している限りは、常に、20分先にタイマーがセットしなおされます。（忙しくセットしなおされていますから、ここは工夫の余地があります）

標準モジュールのここで設定されます。
Private Const SETTIME As Long = 20 'ここに時間を入れます(20分）

ThisWorkbook モジュールの　Workbook_Open　で、
　If InStr(ThisWorkbook.FullName, "\\") = 0 Then Exit Sub
ネットワークのみに作動するようになっています。

標準モジュールの　Sub AutoMessage()　で、
　' .SaveAs Application.DefaultFilePath ...
の「'」コメントブロックを外すと、別名で、クライアント側に保存されます。

なお、私は、自信もってお勧めするわけではありませんが、通常の方法では、OnTime メソッドを使った場合、20分前に、ブックをクローズして、Excel・アプリケーションを開けたままにしておくと、再び、ブックを呼び出し起動してしまいます。ですから、アプリケーションを終了するか、もしくは、タイマーをオフにしないとダメですね。(今回は、アプリケーションは終了はしていません）

それと、一応、こちらが考えていたようなものが出来たつもりでいるのですが、まだ、十分な検査を行っているわけではありません。何かの参考になれば幸いです。

'------------------------------------
'ThisWorkbook モジュール
Private Sub Workbook_Open()
　'ネットワーク上の時だけ起動する
If InStr(ThisWorkbook.FullName, "\\") = 0 Then Exit Sub
　swFlg = True
　Call SetTimer
　MsgBox "自動終了マクロが起動されています。", 64
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
　swFlg = False
　Call SetOffTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　finalFlg = True
　Call SetOffTimer
End Sub

'----------------------------------------
'標準モジュール

Public swFlg As Boolean
Public finalFlg As Boolean
Private myTime As Date
Private LastTime As Date
Private Const SETTIME As Long = 20 'ここに時間を入れます

Sub SetTimer()
　　'強制的に設定する
　　Application.Interactive = False
　　myTime = CDate(Format(Now, "yyyy/mm/dd hh:MM:00")) + TimeSerial(0, SETTIME, 0)
　　LastTime = myTime + TimeSerial(0, 0, 20)
　　If swFlg Then
　　　　Application.OnTime EarliestTime:=myTime, _
　　　　　　　　　　　　　 Procedure:="AutoMessage", _
　　　　　　　　　　　　　 LatestTime:=LastTime
　　End If
　　Application.Interactive = True
End Sub
Sub SetOffTimer()
　On Error Resume Next
　Application.OnTime EarliestTime:=myTime, _
　　　　　　　　　　 Procedure:="AutoMessage", _
　　　　　　　　　　 LatestTime:=LastTime, _
　　　　　　　　　　 Schedule:=False
　On Error GoTo 0
　'終了時には再設定しない
　If finalFlg = False Then
　swFlg = True
　Call SetTimer
　End If
End Sub
Sub AutoMessage()
Dim ret As Integer
Dim Wshell As Object
　　If myTime = 0 Then Exit Sub
　　Set Wshell = CreateObject("WScript.Shell")
　　If Wshell.PopUp("このまま終了しますか。OK/はい" & vbCrLf & myTime, _
　　6, "終了メッセージ", 1 + 32) = 2 Then
　　　 Set Wshell = Nothing
　　　 Call SetOffTimer
　　　 Exit Sub
　　End If
　　Set Wshell = Nothing
　　With ActiveWorkbook
　　　 finalFlg = True
　　　 Call SetOffTimer
　　　 .Save
'　　　.SaveAs Application.DefaultFilePath & "\" & Format(myTime, "hhmmss") & ".xls"　'別名保存
　　　.Close False
　　End With
End Sub

お礼

ありがとうございました。
ご苦労されたのではと思いますが、すばらしいですね。
このようなプログラムが組めればと何時も思うのですが、
つい頼ってしまいます。
社内ランですので、メッセージが出るようになっているのは最高です。
本当にありがとうございました。
また、よろしくお願いいたします。

回答No.1

yokomaya

ＶＢＥでプロジェクトエクスプローラのThisworkbookを
右クリックからコードの表示を行い以下を貼ってみてください。
----------------------------------------------------

Option Explicit
Const 自動保存時間 = 10
Private Sub Workbook_Open()
Application.OnTime Now() + TimeSerial(0, 自動保存時間, 0), "Thisworkbook.自動保存"
End Sub

Public Sub 自動保存()
Application.EnableEvents = False
If ThisWorkbook.Saved = True Then
ThisWorkbook.Close
Else
ThisWorkbook.Save
Application.OnTime Now() + TimeSerial(0, 自動保存時間, 0), "Thisworkbook.自動保存"
End If
Application.EnableEvents = False
End Sub

補足

本当に、ありがとうございます。
なお、ご教示いただいたマクロの時間を変更する場合、例えば15分に
したい時は、Const 自動保存時間 = 10 の10を15にするだけで
よいのでしょうか。
また、入力の途中（エンターキーで確定していない場合）は、自動終了が稼動しませんが、入力の途中でも自動終了となる方法があれば、助か
ります。
いろいろとご迷惑おかけいたしますが、よろしくお願いいたします。