親ブックから子ブックを量産する
データを変えて親ブックから子ブックを量産するマクロ
子ブック生成部分を切り出す
の続き。
FileSystemObjectオブジェクトのCopyFileメソッドを使うと、子ブックの生成が簡単にできることが分かったので、いよいよ量産体制に入る。
そのために、子ブック生成部分だけを切り出しておこう。
リスト1
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
見ての通り、引数を2つ受け取って、新たに生成して保存した子ブックを開いて返すメソッドにした。呼び出され専用なのでPrivateにしている。
まず、(1)からの3行
Dim fsObject As FileSystemObject Set fsObject = New FileSystemObject fsObject.CopyFile Source:=originalFileFullName, _ Destination:=newFileFullName
は、FileSystemObjectオブジェクトのインスタンスを生成して、CopyFileメソッドを用いる。
これで新しい子ブックが保存される。
次に(2)の
Set saveNewWorkbook = Workbooks.Open(newFileFullName)
では、早速保存した新しい子ブックを開いて返り値にしている。
新しく生成された子ブックに加工したいということが多いと思うので、保存しっぱなしではなく、一旦開いて返り値とするというやり方にした。
第2引数のnewFileFullNameをOpenメソッドの引数にそのまま使えるので楽。
子ブックを量産する
あとは、
- 親ブックの「個別」シートに「元データ」シートからデータ(笑)を転記する。
- 一旦親ブックを保存する。
- 別フォルダにコピーを作成し、子ブックとする。
- 子ブックを加工する。
- 子ブックを保存して閉じる。
という処理をForループで回したらよい。
コーディング
リスト2
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プロシージャを実行すると、
「収容所」フォルダにちゃんと5つのファイルができている。
それぞれ「個別」シートのA1セルにデータ(笑)も転記されている。
おわりに
さっそく、
このとき作ったクラスを修正しようかなあ。
ただ、子ブックもマクロ付きのままってのはちょっと具合が悪いんだよなあ。