ExcelVBA ～ ファイルを閉じるときのプログラム（個人用マクロブックが急に生成されてしまったり、他に開いているファイルがあってそちらは閉じたくない場合）
Excelファイルを閉じるコマンドボタンを作りたい時、
・知らないあいだに誰かが「個人用マクロブック(Personal.xlsb)」を
生成してしまっていたり、
・無関係の複数のファイルが開かれてしまっていたりで、
「Application.Quit」だけだと正常にファイルが閉じることができない場合があります。
なので、そのような場合、以降に挙げたようなコードを
標準モジュールに「そのままコピペ」しておくと、
ファイルを閉じるときに変な動きになることを回避できます。
「Auto_Close()」という「Sub」のプロシージャに書くので、コマンドボタンが
「フォームコントロール」でも「ActiveXコントロール」でも、
どちらでもOKです。
また、「Auto_Close()」は、「×」で閉じたときもその内容が実行されるので、
その意味でもダイジョブです。自動上書きして閉じてくれます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 |
' ' Option Explicit Sub Auto_Close() Dim i_WBcnt As Integer Let i_WBcnt = Workbooks.Count ThisWorkbook.Save '上書きして、 If i_WBcnt = 1 Then Application.Quit '↑開いているファイルが1つの場合、Personal.xlsbも何もないので、 ' まんまで閉じる。ThisWorkbook.Closeで閉じるとガワだけが ' のっぺらぼうで残ってしまうため、Application.Quitで閉じる。 If i_WBcnt = 2 Then If WBExistChk("Personal.xlsb") = True Then Application.DisplayAlerts = False Workbooks.Item("Personal.xlsb").Save Application.Quit Else Application.DisplayAlerts = False ThisWorkbook.Save ThisWorkbook.Close End If Else Application.DisplayAlerts = False ThisWorkbook.Save ThisWorkbook.Close End If '↑開いているファイルが２つの場合、Personal.xlsbがあるので、 ' Personal.xlsbがある場合はそっちも一応上書きしてから閉じる。 If i_WBcnt >= 3 Then ThisWorkbook.Close '↑開いているファイルが３つ以上の場合、Personal.xlsbがあろうが ' なかろうが関係ないので、ThisWorkbook.Closeで閉じる。 ' Application.Closeで閉じると、他の無関係のファイルまで ' 閉じようとされてしまうのでThisWorkbook.Closeで閉じる。 ' １つだけのファイルの場合、ThisWorkbook.Closeで閉じると ' ガワだけがのぺらぼうのまま残ってしまうが、 ' ３つ以上の場合はそうならないので、ThisWorkbook.CloseでOK。 End Sub '###################################################################### '指定した名前のワークブックが存在するかどうかのチェックの関数 '存在すればTrueを返し、存在しなければFalseを返します。 'ループを使わない方法＝エラーで判別する方法、でやっています。 'ちょっと手抜き版 '###################################################################### Function WBExistChk(s_WbNm02 As String) As Boolean On Error GoTo error1: If 1 <= Len(Workbooks.Item(s_WbNm02).Name) Then WBExistChk = True Else End If Exit Function error1: WBExistChk = False End Function ' ' |
