プロが教える店舗&オフィスのセキュリティ対策術

標準モジュールで
Sub 終了()
ActiveWorkbook.Close Savechanges:=True
End Sub

THIS WORKBOOKに
MsgBox ("10分後に自動的に保存して閉じます。")
Application.OnTime Now + TimeValue("00:10:00"), "終了"
End Sub
を閉じ忘れ防止の為にこのマクロ入れているのですが、エクセルを普通に閉じたあと、何故か10分後にこの閉じたエクセルを開こうとします。
特にこの構文自体は問題ないかと思いますが、原因として考えられるものはありますでしょうか?

質問者からの補足コメント

  • TimeValue("01:10:00"), "終了"⇒TimeValue("00:10:00"), "終了"
    の間違えです。

    すいません。。

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/11/24 16:42

A 回答 (14件中1~10件)

その3(ステータスバーを使ったもの)



--------------------------------------------------------------------------------
☆ 標準モジュールに
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Public 残時間 As Long
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub カウントダウン()
If 残時間 <= 0 Then
Application.StatusBar = False
ThisWorkbook.Save
If Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close
End If
Else
Application.StatusBar = "あと約" & 残時間 & "秒後に自動終了します"
残時間 = 残時間 - 1
Application.OnTime Now + TimeValue("00:00:01"), "カウントダウン"
End If
End Sub
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
☆ ThisWorkbook に
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Private Sub Workbook_Open()
If ActiveWorkbook.ReadOnly Then
Exit Sub
Else
残時間 = 90
Call カウントダウン
End If
End Sub
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
☆ 対象のシートイベントに
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
残時間 = 90
--------------------------------------------------------------------------------

◎ 自動終了までの時間がステータスバーに表示される
「残時間 = 90」の「90」が秒数です、適当に変更してください。
△ ステータスバーが下に有るので気づきにくい

※ ステータスバーではなく、一行目のセルなどを使えば時間によって色変更なども出来るのでもっと気づきやすいものが出来ます。(多少の変更で実現しますので考えてみてください)
個人的にはこれがお勧めです。
ちなみにこれは「Application.OnTime」を、実装されていない「タイマーイベント」のように使っています。
    • good
    • 0
この回答へのお礼

色々な案、ありがとうございます。
質問なのですが、
ThisWorkbookに残時間 = 90
対象のシートイベントに 残時間 = 90
を2つ同じものを入れるのは何故でしょうか?
お手数ですが、ご教示いただけないでしょうか??

お礼日時:2017/11/25 09:22

これは、面白そうだから、私も昨日から考えてみました。


以下は、私自身で使おうと思って作られたものです。興味がありましたら、試してみてください。
WorkBooks.Count は、Perosnal.xlsb もカウントしてしまうようです。
Addin は数えないようです。そこら辺で、使い分けが可能な気がします。
本来なら、これは、APIタイマーを付けたほうが安定しているような気がします。
また、中止コードとしては、ESCをつけると良いと思っています。それをつけるためには、Timer に与える時間をメモリに入れなくてはなりません。(まだ試行錯誤の中途です)
リボン・ボタンに設置して方がよいと思いました。

なお、VBAの古くからのお約束ですが、Application.Quit を最初にして、次に、ThisWorkbook.Close としています。現行では、32bit PCで、64bit では試していません。


'//ThisWorkbook.モジュール 
#If Win64 Then
Private Declare PtrSafe Function MessageBoxEx Lib "user32" Alias _
  "MessageBoxExA" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption _
  As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long
#Else '32bit版
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
#End If
Private bkNames() 'プロシージャ外変数
Sub AppTimerProc()
Application.OnTime Now + TimeValue("00:10:00"), "ThisWorkbook.AutoClosePrc"
End Sub

Sub AutoClosePrc()
 Dim Wb As Workbook
 Dim Wn As Window
 Dim Ret As Long
 Dim i As Long
 ReDim bkNames(0)
 For Each Wb In Workbooks
   If Wb.Name <> ThisWorkbook.Name Then
    If Wb.Saved = False Then
     ReDim Preserve bkNames(i)
     bkNames(i) = Wb.Name
     i = i + 1
    End If
   End If
 Next
 Ret = MessageBoxTimeoutA(Application.hwnd, "20秒後に自動的に保存し終了します。", "messagebox", vbMsgBoxSetForeground, 0, 2000)
 Application.OnTime Now + TimeValue("00:00:20"), "ThisWorkbook.AppQuit"
End Sub
Sub AppQuit()
Dim i As Long
If bkNames(0) <> "" Then
For i = 0 To UBound(bkNames)
If bkNames(i) <> ThisWorkbook.Name And bkNames(i) <> "" Then
 Workbooks(bkNames(i)).Close Savechanges:=True
End If
Next
End If
Application.Quit '逆になる
ThisWorkbook.Close Savechanges:=True
End Sub
    • good
    • 0
この回答へのお礼

別パターンありがとうございます!

お礼日時:2017/11/25 15:49

No.11 のお礼について



「対象のシートイベントに」の部分は

「Sheet1」などの例えば「SelectionChange」イベントに「残時間 = 90」と書き込めば「Sheet1」でセルの移動が発生すれば残時間が90秒にリセットされます。
--------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
残時間 = 90
End Sub
--------------------------------------------------------------------------------

「Sheet1」などの例えば「Change」イベントに「残時間 = 90」と書き込めば「Sheet1」でセルの値が変化すれば残時間が90秒にリセットされます。
--------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
残時間 = 90
End Sub
--------------------------------------------------------------------------------

つまり、このようなイベントを発生させる作業を行うと残時間が自動で延長されることになります。通常ならばこの2つのイベントが発生しないような作業はあまりないので、セットするイベントはこの2つくらいで良いと思いますがご自由にセットしてみてください。
「その3」だとリアルに体感できると思いますよ。
    • good
    • 0

No.8 のお礼について



その1~その3は、全てそのようになっています。以下の部分です。
--------------------------------------------------------------------------------
If Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close
End If
--------------------------------------------------------------------------------
「Workbooks.Count」が今開いているブック数になります。
「1」の時は、このマクロの有るブックのみ開いているのでエクセルを閉じます。
「その他」の時は、他のブックが開いているので、このマクロの有るブックのみ閉じます。
    • good
    • 0
この回答へのお礼

GooUserラック様>
了解です。
ありがとうございました!

お礼日時:2017/11/25 15:50

その2(Windows Scripting Host の Popupメソッドを使ったもの)



--------------------------------------------------------------------------------
☆ 標準モジュールに
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Option Explicit
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Public 確認時間 As Date
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub 確認時間セット(残分 As Long)
Dim 残時間 As Date
If ThisWorkbook.ReadOnly Then Exit Sub
残時間 = 残分 * 0.0006944
If 確認時間 <> 0 Then
Application.OnTime 確認時間, "確認処理", , False
End If
確認時間 = Now + 残時間
Application.OnTime 確認時間, "確認処理"
End Sub
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub 確認処理()
Dim WSH As Object
確認時間 = 0
Set WSH = CreateObject("Wscript.Shell")
If WSH.Popup("自動終了処理が開始されました。終了処理を一時停止しますか?", 30, , vbDefaultButton2 + vbOKCancel) = vbOK Then
Call 確認時間セット(1)
Else
ThisWorkbook.Save
If Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close
End If
End If
Set WSH = Nothing
End Sub
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
☆ ThisWorkbook に
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Private Sub Workbook_Open()
Call 確認時間セット(1)
End Sub
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
☆ 対象のシートイベントに
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Call 確認時間セット(1)
--------------------------------------------------------------------------------

◎ 自動終了時の30秒前に予告メッセージが出てから終了出来る
「If WSH.Popup("自動終了処理が開始されました。終了処理を一時停止しますか?", 30, , vbDefaultButton2 + vbOKCancel) = vbOK Then」の「30」が秒数です、適当に変更してください。
× 予告メッセージが他のアプリの下に表示されてしまう事がある
※「Call 確認時間セット(1)」の「1」が予告メッセージが表示されるまでの分数です、適当に変更してください。
    • good
    • 0

3バージョンを作ってみました。

それぞれ欠点が有るので実際にテストしていただいて一番使いやすいものをお使いください。

その1(元の物に一番近いもの)

--------------------------------------------------------------------------------
☆ 標準モジュールに
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Public 終了時間 As Date
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub 終了時間セット()
If ThisWorkbook.ReadOnly Then Exit Sub
If 終了時間 <> 0 Then
Application.OnTime 終了時間, "終了", , False
End If
終了時間 = Now + TimeValue("00:03:00")
Application.OnTime 終了時間, "終了"
End Sub
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub 終了()
終了時間 = 0
ThisWorkbook.Save
If Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close
End If
End Sub
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
☆ ThisWorkbook に
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If 終了時間 <> 0 Then
Application.OnTime 終了時間, "終了", , False
End If
End Sub
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Private Sub Workbook_Open()
If ActiveWorkbook.ReadOnly Then
Exit Sub
Else
MsgBox ("閉じ忘れ防止の為、3分間操作しない場合自動保存して閉じます。")
Call 終了時間セット
End If
End Sub
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
☆ 対象のシートイベントに
'・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Call 終了時間セット
--------------------------------------------------------------------------------

※ 自動終了時予告もなく終了してしまう
    • good
    • 0

No.7 のお礼について



ちょっと誤解されてしまっているようです。エクセルはこのブックだけに使っているわけではないですよね?全然関係ない他のブックも同時に開くことが出来ますよね!その時はどうしますか?と言う事です。
    • good
    • 0
この回答へのお礼

申し訳ありません。。ほかの関係ないブックは、そのままでお願いしますm(_ _)m

お礼日時:2017/11/25 06:33

自動延長はもちろん可能です。



もう一つ確認です。他のエクセルファイルを開いていた場合はどうしますか?
① 自分だけ保存して閉じる。他はそのままにしておく。
② 他も保存してエクセルも閉じる。
    • good
    • 0
この回答へのお礼

エクセルは共有化していないため、ひとりしか開けない仕様にしています。あとで開く人は読み取り。開いた人が閉じるのを忘れたとき用で時間が経つと閉じるようにしています。なので①になりますね(_ _)

お礼日時:2017/11/24 21:48

1つ確認が有ります。



このコードだと確認ボタンを押すと、作業中でも10分後に閉じてしまいますが良いのでしょうか?
セルをの選択位置を変えたりしたときに、それから10分後に自動で延長した方が良いのでは?
    • good
    • 0
この回答へのお礼

開きっぱなし防止と10分以上は使用しないかなと思いました。可能であれば、自動延長がよいのですが、複雑になりそうなのでできませんでした…可能でしょうか?

お礼日時:2017/11/24 18:27

No.4 のお礼について



もしかしたら、この機能を使わず途中で閉じてしまったときにエクセル内にこの命令が残ってしまっているのでは?の確認のために閉じる時にこの機能をキャンセルしています。

別のエクセルファイルを開いているときにいろいろと問題になりそうなコードなので…
なお「Sub 終了」にはもう一工夫必要そうなので、結果が良くても数日閉じないでおいていただけると幸いです。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!