VBAの資源管理
ここではVBAが扱う全ての資源について考えてみたいと思います。
BookやSheetの名前付けと保存する場所。履歴（バックアップ）の作成ルール。それに対応するプロシージャのやフォームの記述方法とそれ自身の名称管理について提案をしたいと思います。
使用者の前提としては企業内でだいたい下図のような環境でデータの集約や集計をしてサーバに上げる、またはメールで配信するようなイメージです。
上記はあくまで例に過ぎませんが、企業では自身のユーザー名や、人が提供するサーバー上のフォルダ名、ファイル名は自分の思うとおりにならないばかりか、変更されることもあります。モジュール内にディレクトリ名やBook名があると、そのたびにモジュール内のBookの位置をいちいち変更するのは大変な手間となります。また同僚に業務を引き継ぐのも大変です。そこで次のようなコード作成を提案します。
1.モジュール内にBook名を書かない
モジュール内にBook名がなければ、Bookの位置が変わっても、モジュールを変更する必要がありません。それはBookの位置を変えるモジュール変更をした場合のモジュールの変更間違い、変更漏れによるトラブルを防ぐことができます。具体的には次のような手段が考えられます。
(2)使用するファイル(Book)の情報を1枚のシートにまとめておく(Worksheet関数）
他にもいろいろ考えられると思いますが、私が主に使うのは以上のような方法です。
では各手順について詳しく見ていきましょう。
以下のモジュールは Range("AL1")に書き込まれているディレクトリBook名でそのBookを開き、売上明細というSheetの内容を全て、現在開いているBookのSheet2の１行目に書き込むというものです。
Book名の記述をどこにするかがポイントになります。
ヘッダー部を下げるという方法が一般的かと思いますが、モジュールの使い回しに不便が発生します。
また列の削除や挿入をするとRange("AL1")の位置がずれてしまうのも難点です。
*************************************************
Sub A010_売上明細インポート()
'*************************************************
Dim MaxRow As Long
Dim xlBook3 As Workbook
Dim fname3 As String
Dim RANGE1 As String
' 高速化処理 画面出力停止、再計算停止
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'***** copy先シートを初期クリアー
Worksheets("Sheet2").Select
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'フィルター選択解除
Worksheets("Sheet2").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
'***** Copy 元 ファイル情報取得
fname3 = Cells(1, "L") ' =Rang("AL1")
'***** Copy 元 ファイル存在確認 ＆ オープン または なかった場合の処理
If Dir(fname3) <> "" Then
Set xlBook3 = Workbooks.Open(fname3)
Else
MsgBox fname3 & " が存在しません"
Exit Sub
End If
xlBook3.Sheets("売上明細").Select
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row ' 最終行､列の取得
'***** Copy 処理
RANGE1 = "A1:J" & MaxRow
Range(RANGE1).Copy
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlAll
Application.DisplayAlerts = False
xlBook3.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True 'ディスプレイ出力再開
Application.Calculation = xlCalculationAutomatic '関数自動計算再開
End Sub
（2）-① 使用するファイル(Book)の情報を1枚のシートにまとめておく
（この方法は『報告書の作成』でも述べています）
以下のモジュールは 現在開いているBook【環境設定】シートのRange("C2")に書き込まれているディレクトリBook名でそのBookを開き、売上明細というSheetの内容を全て、現在開いているBookのSheet2の１行目に書き込むというものです。
赤字の部分だけ上記のモジュールから変更になっています。
プログラミング上はたいした変更ではありませんがメインシート【Sheet2】を扱う自由度は格段に向上します。
しかしながら、運用者や協同開発者と事前に合意しておくことが必要となります。また【環境設定】を読み込んだ後は元のSheetにもどるかどうかも統一しておいた方がよいでしょう。
続く②ではSheetのselectを使わない方法を紹介します。多くのシートを扱う場合にはこちらの方法をお勧めします。
'*************************************************
Sub A020_売上明細インポート()
'*************************************************
Dim MaxRow As Long
Dim xlBook3 As Workbook
Dim fname3 As String
Dim RANGE1 As String
' 高速化処理 画面出力停止、再計算停止
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'***** copy先シートを初期クリアー
Worksheets("Sheet2").Select '※1
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'フィルター選択解除
Worksheets("Sheet2").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
'***** Copy 元 ファイル情報取得
Worksheets("環境設定").Select '※1
fname3 = Range("C2") '※1
Worksheets("Sheet2").Select '※1
'***** Copy 元 ファイル存在確認 ＆ オープン または なかった場合の処理
If Dir(fname3) <> "" Then
Set xlBook3 = Workbooks.Open(fname3)
Else
MsgBox fname3 & " が存在しません"
Exit Sub
End If
xlBook3.Sheets("売上明細").Select ’※1
MaxRow = Cells(Rows.Count, "A").End(xlUp).Row ' 最終行､列の取得 ’※1
'***** Copy 処理
RANGE1 = "A1:J" & MaxRow ’※1
Range(RANGE1).Copy ’※1
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlAll ’※1
Application.DisplayAlerts = False
xlBook3.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True 'ディスプレイ出力再開
Application.Calculation = xlCalculationAutomatic '関数自動計算再開
End Sub
（2）-② 使用するファイル(Book)の情報を1枚のシートにまとめておく（Selectせずにbook,Wrksheet名記述）
先ず(2)-① の※1 の部分を select 分を用いずに、セルの位置指定を全て、book,sheet指定にします。
複数book、複数sheetを使用する場合その数が多い場合、どこからどこにcopyするか明確になり
あとからコードを見直す時、より分かりやすくなります。
'*************************************************
Sub A020B_売上明細インポート()
'*************************************************
Dim MaxRow As Long
Dim xlBook3 As Workbook
Dim fname3 As String
Dim RANGE1 As String
' 高速化処理 画面出力停止、再計算停止
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'***** copy先シートを初期クリアー
If Worksheets("Sheet2").FilterMode Then ActiveSheet.ShowAllData 'フィルター選択解除
Worksheets("Sheet2").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
'***** Copy 元 ファイル情報取得
fname3 = Worksheets("環境設定").Range("C2")
'***** Copy 元 ファイル存在確認 ＆ オープン または なかった場合の処理
If Dir(fname3) <> "" Then
Set xlBook3 = Workbooks.Open(fname3)
Else
MsgBox fname3 & " が存在しません"
Exit Sub
End If
MaxRow = Sheets("売上明細").Cells(Rows.Count, "A").End(xlUp).Row ' 最終行､列の取得
'***** Copy 処理
RANGE1 = "A1:J" & MaxRow
Sheets("売上明細").Range(RANGE1).Copy
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlAll
Application.DisplayAlerts = False
xlBook3.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True 'ディスプレイ出力再開
Application.Calculation = xlCalculationAutomatic '関数自動計算再開
End Sub
（2）-③ (2)-②では、一つのセルや範囲を記述するのにbook名やsheet名を付け加えるため少し
文字数が多くなってしまいました。そこでWortsheet変数を用いてこれを短縮します。
Worksheet変数は事前にdim文で定義すること、set文でその目的のシート名をWorksheet変数の中に
入れることが必要になります。
その場合、その命令が実行された時点でActiveになっているBook名も自動的に記憶されるため
Worksheet変数を使用する場合、Book名の指定は不要となります。
下記の赤字部分がset文を挿入した場所です。それによってセルや範囲の記述を短くすることができました。
'*************************************************
Sub A020C_売上明細インポート()
'*************************************************
Dim MaxRow As Long
Dim xlBook3 As Workbook
Dim fname3 As String
Dim RANGE1 As String
Dim sh_2, sh_kan_sh_meisai As Worksheet '※2
' 高速化処理 画面出力停止、再計算停止
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'***** copy先シートを初期クリアー
Set sh_2 = Worksheets("Sheet2")
Set sh_kan = Worksheets("環境設定")
If sh_2.FilterMode Then ActiveSheet.ShowAllData 'フィルター選択解除
sh_2.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
'***** Copy 元 ファイル情報取得
fname3 = sh_kan.Range("C2")
'***** Copy 元 ファイル存在確認 ＆ オープン または なかった場合の処理
If Dir(fname3) <> "" Then
Set xlBook3 = Workbooks.Open(fname3)
Else
MsgBox fname3 & " が存在しません"
Exit Sub
End If
Set sh_meisai = Sheets("売上明細")
MaxRow = sh_meisai.Cells(Rows.Count, "A").End(xlUp).Row ' 最終行､列の取得
'***** Copy 処理
RANGE1 = "A1:J" & MaxRow
sh_meisai.Range(RANGE1).Copy
sh_2.Range("A1").PasteSpecial Paste:=xlAll
Application.DisplayAlerts = False
xlBook3.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True 'ディスプレイ出力再開
Application.Calculation = xlCalculationAutomatic '関数自動計算再開
End Sub
(2)は仕組みが分かっていれば使いやすいですが、直感的には使いにくいといえます。マクロからファイルを開く場合にオペレータに選んでもらうのは有効な選択肢の一つになります。
今回はフォームを使ってファイル（及びディレクトリ）の入力をしてみましょう。
①フォームの登録
開発 ⇒ Visualbasic ⇒ 挿入 で下記のような画面が出ますので 【ユーザーフォーム】を選択します。
②空のフォームに部品（オブジェクトを貼り付ける）
ツールボックスからオブジェクトの種類を選択して、オブジェクトを貼り付けていきます。
図形の挿入と同じような感覚です。
③実際の貼付例
今回の目的の沿って３つのオブジェクトを貼り付けました。
形としてのフォームの入力は以上で終了です。実際にはボタン表示はオブジェクト名が表示され。もっと味気ないデザインになります。最低限の編集をするためには次の４つを操作する必要があります。
- Caption 表示文字
- Backcolor 背景色
- Font 文字フォント
- Forecolor 文字色
飽き足りない方は 各オブジェクトのプロパティを変更して工夫してみて下さい。
④モジュールの記入例
次に【ファイルを選択】のボタンを押した場合の動作をマクロで記述します。このマクロはモジュールのエリアではなく『フォームの中の領域にオブジェクト別に記述』することになります。
フォームの中のサブプロシージャはモジュールのエリアのそれと同じように作成できます。
ただし実行するためには、モジュールでフォームを呼び出す。そのフォームの中でコマンドボタンを押す。という手順を踏まないと実行できません。少し面倒です。
・フォームを呼び出すサブプロシージャ
'*************************************************
Sub A030_form呼び出し()
'*************************************************
UserForm2.Show
End Sub
********************************************************************
・コマンドボタンを押したときの動作（フォームの中に書く）
③の画面からボタンの位置にカーソルを置いてダブルクリックすると、サブプロシージャの名前とEnd Sub を設定してくれます。勝手な名前をつけてもボタンを押した時に作動しません。
'*************************************************
Private Sub CommandButton1_Click()
'*************************************************
Dim FNAME As String
Dim Dname As String
Sheets("環境設定").Select
Dname = Cells(3, "C")
Sheets("Sheet2").Select
If Dname <> "" Then 'ディレクトリ名が空白ではなくかつ
If Dname <> "False" Then 'ディレクトリが有効な場合な時
CreateObject("WScript.Shell").CurrentDirectory = Dname
End If
End If
FNAME = Application.GetOpenFilename("Excelブック,*.xlsx")
If FNAME <> "False" Then 'ファイル名が入力されたときの処理
Sheets("環境設定").Select
Cells(2, "C") = FNAME
Sheets("Sheet2").Select
Unload Me
Call A020_売上明細インポート
Else
Unload Me
Exit Sub
End If
End Sub
*****************************************************************************
Application.GetOpenFilenameはファイル選択画面を呼び出す命令です
CreateObject("WScript.Shell").CurrentDirectory はその際どこのフォルダを見に行くかの設定です。設定しなければカレントディレクトリを見に行きます。上記の例では『環境設定』シートの "C3"で設定されています。直前のIf Dname <> "False" Then はそのフォルダが実在しているかどうかの確認です。但し Dnameが空白の時は（なぜか）有効(実在）となってしまいます。2つの条件を満たしていないとapplication.GetOpenFilename実行時にエラーとなって先に進めません。
選択されたフォルダ＆ファイル名を『環境設定』シートに書き込んであとはの作業はA020_売上明細インポートに任せます。
１－(4) すでに開いているBookを使用する－Book名固定
Bookの名前と保存する場所を決めておいてそれを呼び出す、という前提の操作を勧めてまいりましたが、時には一時的に作成したBookを使用したいという場合もあると思います。
次の例は最も単純な使用方法です。最初の行はいったん保存されてファイル属性（.以下の部分）が決まっているBook。次の行は作成したばかり、または他のシステムからダウンロードされたばかりのBookです。
Sheetしていしていないので保存時のSheet、または現に表示されているSheetが使われます。
'*************************************************
Sub A040_開いているbook1()
'*************************************************
Workbooks("記録.xlsx").Activate
MsgBox Range("A1")
Workbooks("book1").Activate
MsgBox Range("A1")
End Sub
'*************************************************
問題となるのは、これらのが開いていなかった場合異常終了することです。個人使用なら構いませんが、誰かに使ってもらうとなると不親切すぎます。そこで次のように手を加えてみます。Sheet名はSheet1とします。
'*************************************************
Sub A050_開いているbook2()
'*************************************************
Dim xlBook As Workbook
Dim Target As String
Dim flg As Boolean
Target = "記録.xlsx"
'現在開いている全てのBookを探す
For Each xlBook In Workbooks
If xlBook.Name = Target Then flg = True
Next xlBook
'探しているBookがあったとき
If flg = True Then
Workbooks(Target).Activate
Worksheets("Sheet1").Select
MsgBox Range("A1")
Else
'探しているBookがなかったとき
MsgBox Target & " 対象ファイルが開いていません"
Exit Sub
End If
End Sub
'*************************************************
１－(4) すでに開いているBookを使用する－Book名選択
1-(4)では『モジュール内にBook名を書かない』という趣旨に合わないため、開いているファイル内から使用するBookを選択する方法を紹介します。ここでもFormを使用します。
複数の候補から１つを選ぶため、TextBoxではなく、ListBoxを使用します。
ListBoxには事前に選択肢を表示したいので、Formを立ち上げたときに、開いているBookを全て表示します。
'フォームの中に記述するモジュール
Private Sub UserForm_Initialize() 'フォームの初期表示
Dim xlBook As Workbook
Dim Target As String
Dim flg As Boolean
For Each xlBook In Workbooks
ListBox1.AddItem xlBook.Name 'フォームの要素に追加する
Next xlBook
End Sub
Private Sub CommandButton1_Click()
Target2 = ListBox1 'リストボックスで選ばれた名称をTarget2 送る
Unload Me
Workbooks(Target2).Activate
MsgBox Range("A1")
End Sub
’*****************************************************************************************
’Module に記述するモジュール
Public Target2 As String 'グロ-バル変数の宣言
'*************************************************
Sub A060_form呼び出し()
'*************************************************
UserForm3.Show
End Sub
ここではフォームの要素への追加、コマンドボタンを押したときに選択したファイル名をTarget2に送る記述
そして"Target2" はDiPublicPublic文で定義することが特徴です。
Publicはグロ-バル変数の定義方法です。グローバル変数にすることでモジュールの外（Formの中）にあるモジュールと情報を共有できます。
一つのBookの中で特定の目的のためだけに使用することをお勧めします。
なお、下記はフォームを開いたときの状態です。
