マクロのBeforeCloseイベントについて教えて下さい。 ブック1とブック2を同じエクセルで2つ

マクロのBeforeCloseイベントについて教えて下さい。

ブック1とブック2を同じエクセルで2つ開いています。

ブック2のBeforeCloseイベントで下記のコードを実行したい
のですがうまくいきません。

やりたい事↓

ブック2とブック1のみ開いている状態で、
ブック2を閉じるとブック1も閉じてエクセル自体が終了する。

ブック1は読み取り専用で開いているので保存は不要。

ブック2は通常通りに変更があれば「変更を保存しますか？」の
コメントは出るようにしたい。


Private Sub Workbook_BeforeClose(Cancel As Boolean)

Workbooks("book1.xlsm").Close savechanges:=False

Application.Quit

End Sub


いろいろ試しましたが、エクセル自体の終了ができずに画面が
残ってしまいます。

どなたかご教授下さい。

お願いします。

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

• 回答ありがとうございます。
  
  回答の通りやってみたのですが、やはりエクセルが残ってしまいます。

    補足日時：2019/09/02 06:14

• エクセル2010を使用しています。

    補足日時：2019/09/02 10:16

• 細かい回答ありがとうございます。
  
  早速やっみます。
  
  ちなみにこれは2010以外でも動作しますか？

    補足日時：2019/09/02 23:15

• すいません。
  
  １つ問題がありました。
  
  ブックに変更があった場合に最後にブックの保存を聞かれるダイアログが通常通り出ますが、キャンセルが出来ません。
  
  このダイアログはそのままにしたいです。
  
  もう一度御教授お願い致します。

    補足日時：2019/09/03 19:51

• このコードは私の質問だとブック1とブック2のどちらに書けばいいですか？
  ブック2でいいでしょうか。

    補足日時：2019/09/03 21:27

• いろいろ試してみたのですが、wb1.closeのところをwb1.close savechanges:=falseにしました。
  
  
  また、最期のところはthisworkbook.closeに変更しました。
  
  最初のブック名取得（wb1）のところは私の質問文のブック1を格納してあります。
  
  上記コードをブック2へ記載しました。
  
  動きはほぼ希望通りで、ブック1は自動で閉じてブック２は保存するかのダイアログがしっかり出ます。
  
  ここで「保存しますか？」に対して「はい」か「いいえ」を選択するとその通りに動いてエクセル自体を終了してくれます。
  
  しかし、ここで「キャンセル」を選択すると先へ進めなくなってしまいます。

    補足日時：2019/09/04 06:55

• いろいろと考えて頂きありがとうございます。
  だいぶ出来て来ましたがまだ少し問題があります。
  
  保存しますか？のメッセージボックスで「はい」や「いいえ」などを選ぶとそのままファイルを閉じる方向に動くと思いますが、その後もう一回同じメッセージボックスが出てきます。
  
  また、「いいえ」を選んだときはダイアログも出てきます。

    補足日時：2019/09/05 20:14

No.1 回答者： WindFaller 回答日時： 2019/09/01 23:56

Private Sub Workbook_BeforeClose(Cancel As Boolean)

　Dim Wb1 As Workbook
　On Error Resume Next
　Set Wb1 = Workbooks("book1..xlsm")
　If Err.Number = 0 Then
　　Application.Quit
　　Wb1.Close
　End If
　On Error GoTo 0
End Sub


ふたつのブックを結ばせる方法は別に、参照設定を使った方法がありますが、以上のようにすれば、何も残さないで終われるはずです。

なお、
「ブック2とブック1のみ開いている状態で、」
というのは、
If Workbooks.Count = 2 Then .....
となるのですが、これを加えた条件は必要がない気がしました。
マクロで、Excelを終了させるのは、最初にApplication.Quit を入れておいて、次に個別のブックのタスクをさせるのがコツです。Application.Quit を命令しても、すぐに反応しないからです。

No.2 回答者： WindFaller 回答日時： 2019/09/02 07:36

>回答の通りやってみたのですが、やはりエクセルが残ってしまいます。

Excelのバージョンはいくつですか?
確か、思うように行かないバージョン(Excel 2010? 2007? )が存在していたかと思います。
その場合は、こちらのコードも、それに合わせてみないと、正直な所分かりません。
ただ、基本的な考え方は、Application.Quit を先に書くということです。

No.3 回答者： WindFaller 回答日時： 2019/09/02 20:48

遅くなりました。

>エクセル2010を使用しています。

さきほど、#1のコードではうまく行かないことを確認しました。この件は、私も昔、何度も何度もトライした覚えがあります。これが、エクセル2010の特徴のようです。エクセル2016では、この問題は発生しません。

あまり、褒められないコードですが、試してみてください。

'//ThisWorkbook モジュールに、

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Wb1 As Workbook
On Error Resume Next
　''以下のブックがない場合は、エラーをスキップします。
Set Wb1 = Workbooks("bookB.xlsm")
　'ブック名を登録してください。フルパスは不要です。
If Err.Number = 0 Then
　Wb1.Close
End If
On Error GoTo 0
If Val(Application.Version) = 14 Then
　'エクセル2010に対するもので、他のバージョンでは措置はしません。
　Application.OnTime Now + TimeSerial(0, 0, 1), "Finalize", TimeSerial(0, 0, 10), True
　''Finalize プロシージャは、標準モジュールに置くこと
Else
　Application.Quit
　ThisWorkbook.Close False 'リードオンリー
　　'このブックに変更後の保存を求めません。
End If
End Sub


'//標準モジュール
Sub Finalize()
Application.Quit
ThisWorkbook.Close
End Sub

''//現行では、ブックBがあってもなくても、Excel2010では、OnTime メソッドを発生させ、時間差で命令を送る設定になっています。

エクセル2010 (+Windows10)で何度もシミュレーションしてみて、こちらでは成功しています。ただ、とても、イレギュラーなコードだと思いますので、他の方で経験されている方がいましたら、そちらの方の意見も参考にしてみてください。ただし、エクセル2010を持っていない方には、分からないかもしれません。

No.4 回答者： WindFaller 回答日時： 2019/09/03 01:59

>ちなみにこれは2010以外でも動作しますか？

{'エクセル2010に対するもので、他のバージョンでは措置はしません。}

失礼しました。書き方が悪かったです。エクセル2010の時だけ、特別な動きをするという意味ですが、試してみましたが、エクセル2016では、問題なく終われます。後は、2013ですが、調べていないのですが、たぶん大丈夫だと思います。

If Val(Application.Version) = 14 Then
この14というのが、2010のバージョン番号です。

　　表品名　Ver　　VB-Ver.
Excel 2007 12.0 　VB6
Excel 2010 14.0　　VB7
Excel 2013 15.0 　　　↓
Excel 2016 16.0　　　↓

13がないのは、忌み数

ただ、確か、エクセル2007も同様の仕様だった気がしますから、
もし問題があるようなら、
If Val(Application.Version) = 14 Or Val(Application.Version) =12 Then
としたほうがよいかと思います。それ以下のバージョンについては、このようなトラブルは発生しなかったようです。もともと、このテクニック(Application.Quit と Closeを逆にする)は、2003頃に教わったものですから。

--------------
>If Val(Application.Version) = 14 Then
> 'エクセル2010に対するもので、他のバージョンでは措置はしません。
> Application.OnTime Now + TimeSerial(0, 0, 1), "Finalize", TimeSerial(0, 0, 10), True
> ''Finalize プロシージャは、標準モジュールに置くこと
Else
'通常処理
End If

この回答へのお礼

ありがとうございます。
うまくいきました。

バージョンは指定しなくても動作しました。

助かりました。

お礼日時：2019/09/03 18:57

No.5 回答者： WindFaller 回答日時： 2019/09/03 20:51

>ブックに変更があった場合に最後にブックの保存を聞かれるダイアログが通常通り出ますが、キャンセルが出来ません。

そういうリクエストだったと思っていましたので、失礼しました。

No.3のコードを参照して、

以下を変更します。
'　ThisWorkbook.Close False 'リードオンリー (前)
'　　　↓
　ThisWorkbook.Close　'通常の保存ダイアログが出ます。(訂正後)

No.6 回答者： WindFaller 回答日時： 2019/09/04 23:06

>「キャンセル」を選択すると先へ進めなくなってしまいます。

「先に進める」というタスクが、よく分かっていないのですが、一般的にキャンセルをクリックするというのは、閉じるのをやめるという意味ですよね。
違いましたら、また、ご連絡ください。

昔の記録を見ながら、2008年の頃の私は、もうちょっと、しっかり書いていたようですが、今回、穴だらけです。まだしっくりしていない部分があるのですが……。(申し訳ないというしかありません。)

しっくりしていないひとつに、
Application.Calculation = xlCalculationManual
を以下に含めるべきかです。しかし、終了時に入れると動作がおかしくなりそうなのでやめています。

'//
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　Cancel = False
　Dim Wb1 As Workbook
　Dim msgRet As VbMsgBoxResult
　On Error Resume Next
　Set Wb1 = Workbooks("bookB.xlsm") ''要ブック登録
　If Err.Number = 0 Then
　　Wb1.Close
　　ThisWorkbook.Activate
　End If
　On Error GoTo 0
　If ThisWorkbook.Saved Then
　　msgRet = MsgBox("'" & Me.Name & "'の変更内容を保存しますか?", vbExclamation + vbYesNoCancel)
　　If msgRet = vbCancel Then
　　　Cancel = True
　　　Exit Sub
　　ElseIf msgRet = vbYes Then
　　　ThisWorkbook.Save
　　ElseIf msgRet = vbNo Then
　　　ThisWorkbook.Saved = False
　　End If
　Else
　　msgRet = MsgBox("'" & Me.Name & "'を終了しますか?", vbExclamation + vbOKCancel)
　　If msgRet = vbCancel Then
　　　Cancel = True
　　　Exit Sub
　　End If
　End If

　Application.EnableEvents = False
　If Val(Application.Version) = 14 Then
　　Application.OnTime Now + TimeSerial(0, 0, 1), "Finalize", TimeSerial(0, 0, 10), True
　Else
　　Application.Quit
　　ThisWorkbook.Close False
　End If
　Application.EnableEvents = True
End Sub

'これを加えてください。
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'保存ダイアログを出さないため
SaveAsUI = False
End Sub


'//標準モジュール
Sub Finalize()
　Application.Quit
　ThisWorkbook.Close False
End Sub

No.7 回答者： WindFaller 回答日時： 2019/09/09 01:31

ずっとやってみましたが、開発は、2016でやっていますが、Excel 2010 でやると、どうにもうまきできません。

考えてみましたが、BookAの終了で、BookB側が反応するのは、Excel 2010では無理があるのか、例えば、インスタンスを設けるなど、あまり特殊な処理方法は避けようと思いました。(実際、これはエラーが出ました。)

今の所、NO.6がベストというところです。
しばらく、まだ開けておいてくださるなら、結論を数日の間に出します。

No.8 回答者： WindFaller 回答日時： 2019/09/14 21:22

遅くなりました。

結論からすると、Excel2010 のWorkbook_BeforeClose に、イベント型マクロとして取り付けるのは、無理だったということです。その代替案としては、以下のWorkbooksClose というプロシージャをフォームコントロールのボタンに取り付けたらどうかと考えました。
むろん、両方のBookのイベントを働かないようにするなら、可能ですが、そこまでは手をつけたくなかったのです。

''//標準モジュール
Sub WorkbooksClose()
　Dim Wb1 As Workbook
　Dim msgRet As VbMsgBoxResult
　On Error Resume Next
　Set Wb1 = Workbooks("bookB.xlsm")
　If Err.Number = 0 Then
　　If Wb1.Saved Then
　　　SaveDialog Wb1, 1
　　Else
　　　SaveDialog Wb1
　　End If
　　On Error GoTo 0
　 End If
　　If ThisWorkbook.Saved Then
　　　SaveDialog ThisWorkbook, 1
　　Else
　　　SaveDialog ThisWorkbook
　　End If
End Sub

Function SaveDialog(objBk As Workbook, Optional opt As Integer = 0)
'Option 0--保存, 1--保存不要
　Dim msgResult As VbMsgBoxResult

　If opt = 0 Then
　　msgResult = MsgBox("'" & objBk.Name & "'の変更内容を保存しますか?", vbExclamation + vbYesNoCancel)
　　If msgResult = vbCancel Then
　　　ThisWorkbook.Activate
　　　End
　　ElseIf msgResult = vbYes Then
　　 Call Finalize(objBk)
　　　objBk.Save
　　　objBk.Close False
　　ElseIf msgResult = vbNo Then
　　　Call Finalize(objBk)
　　　 objBk.Close False
　　End If
　Else
　　msgResult = MsgBox("'" & objBk.Name & "'を終了しますか?", vbExclamation + vbOKCancel)
　　If msgResult = vbOK Then
　　　Call Finalize(objBk)
　　ElseIf msgResult = vbCancel Then
　　　ThisWorkbook.Activate
　　　End
　　End If
　End If
End Function '

Sub Finalize(objBk As Workbook)
　If ThisWorkbook.Name = objBk.Name And _
　 Val(Application.Version) = 14 Then
　　Application.OnTime Now + TimeSerial(0, 0, 1), "Finalize", TimeSerial(0, 0, 15), True
　Else
　　Application.Quit
　End If
End Sub

'//
良い結果には終わりませんでしたが、辛抱してくださってありがとうございます。