親ブックから子ブックを量産する

データを変えて親ブックから子ブックを量産するマクロ

子ブック生成部分を切り出す

akashi-keirin.hatenablog.com

の続き。

FileSystemObjectオブジェクトのCopyFileメソッドを使うと、子ブックの生成が簡単にできることが分かったので、いよいよ量産体制に入る。

そのために、子ブック生成部分だけを切り出しておこう。

リスト１

Private Function saveNewWorkbook(ByVal originalFileFullName As String, _
                                 ByVal newFileFullName As String) As Workbook
  Dim fsObject As FileSystemObject    '……(1)'
  Set fsObject = New FileSystemObject
  fsObject.CopyFile Source:=originalFileFullName, _
                    Destination:=newFileFullName
  Set saveNewWorkbook = Workbooks.Open(newFileFullName)    '……(2)'
  Set fsObject = Nothing
End Function

見ての通り、引数を２つ受け取って、新たに生成して保存した子ブックを開いて返すメソッドにした。呼び出され専用なのでPrivateにしている。

まず、(1)からの３行

Dim fsObject As FileSystemObject
Set fsObject = New FileSystemObject
fsObject.CopyFile Source:=originalFileFullName, _
                  Destination:=newFileFullName

は、FileSystemObjectオブジェクトのインスタンスを生成して、CopyFileメソッドを用いる。

これで新しい子ブックが保存される。

次に(2)の

Set saveNewWorkbook = Workbooks.Open(newFileFullName)

では、早速保存した新しい子ブックを開いて返り値にしている。

新しく生成された子ブックに加工したいということが多いと思うので、保存しっぱなしではなく、一旦開いて返り値とするというやり方にした。

第２引数のnewFileFullNameをOpenメソッドの引数にそのまま使えるので楽。

子ブックを量産する

あとは、

• 親ブックの「個別」シートに「元データ」シートからデータ（笑）を転記する。
• 一旦親ブックを保存する。
• 別フォルダにコピーを作成し、子ブックとする。
• 子ブックを加工する。
• 子ブックを保存して閉じる。

という処理をForループで回したらよい。

コーディング

リスト２

Public Sub main()
  Dim originalWorkbook As Workbook
  Set originalWorkbook = ThisWorkbook
  Dim folderPath As String
  folderPath = originalWorkbook.Path & "\収容所\"  '"
  If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath)
  Dim orgDataSh As Worksheet
  Set orgDataSh = originalWorkbook.Worksheets("元データ")
  Dim tgtSh As Worksheet
  Set tgtSh = originalWorkbook.Worksheets("個別")
  Dim maxRow As Long
  maxRow = orgDataSh.Cells(Rows.Count, 2).End(xlUp).Row
  Dim newWorkbook As Workbook
  Dim i As Long
  For i = 2 To maxRow
    tgtSh.Range("A1").Value = orgDataSh.Range("B" & i).Value    '……(1)'
    Application.DisplayAlerts = False    '……(2)'
    originalWorkbook.Save    '……(3)'
    Set newWorkbook = saveNewWorkbook(originalWorkbook.FullName, _
                                      folderPath & "子ブック" & Format(i - 1, "0#") & ".xlsm")    '……(4)'
    newWorkbook.Worksheets("元データ").Delete    '……(5)'
    newWorkbook.Close True    '……(6)'
    Application.DisplayAlerts = True    '……(7)'
  Next
  Set originalWorkbook = Nothing
  Set orgDataSh = Nothing
  Set tgtSh = Nothing
  Set newWorkbook = Nothing
End Sub

Forループに入るまでの処理については、説明を省略。オーソドックスな処理ばかりだと思う。

で、Forループの中身だが、

まず(1)の

tgtSh.Range("A1").Value = orgDataSh.Range("B" & i).Value

で、親ブックの「元データ」シートから親ブックの「個別」シートにデータ（笑）を転記。

(2)の

Application.DisplayAlerts = False

でアラート表示を止める。これをやっておかないと、次の処理のときにアラート表示が出てしまう。

(3)の

originalWorkbook.Save

で親ブックを保存。こうしておかないと、データ（笑）の転記が子ブックに反映されない。

ここまで下ごしらえをしておいて、いよいよ(4)の

Set newWorkbook = saveNewWorkbook(originalWorkbook.FullName, _
                                  folderPath & "子ブック" & Format(i - 1, "0#") & ".xlsm")

で子ブックを保存した上で開き、変数newWorkbookに格納。

(5)の

newWorkbook.Worksheets("元データ").Delete

で子ブックの「元データ」シートを削除し、

(6)の

newWorkbook.Close True

で、子ブックを保存して閉じる。

最後に(7)の

Application.DisplayAlerts = True

でアラート表示を元に戻したら、オブジェクト変数を解放して終了。

実行

mainプロシージャを実行すると、

「収容所」フォルダにちゃんと５つのファイルができている。

それぞれ「個別」シートのＡ１セルにデータ（笑）も転記されている。

おわりに

さっそく、

akashi-keirin.hatenablog.com

このとき作ったクラスを修正しようかなあ。

ただ、子ブックもマクロ付きのままってのはちょっと具合が悪いんだよなあ。

@akashi_keirin on Twitter