適材適所

PowerShellやVBAなどのプログラミングに関すること、キャリア、子育ての3本で書いていきます

Excel VBAで差し込み印刷を実現する

ExcelとVBAを使った差し込み印刷のやり方 part2です。

前回の記事では、差し込む先のテンプレートはシート内に1つだけでした。

Wordの差し込み印刷だと、1つのテンプレートに複数のレコードを差し込むことができます。

きっと差し込み印刷というとこっちを想像する方が多かったのかも・・・と前回の記事を書いた後に思った次第です。

ということで、前回の記事に続き、今度は「ExcelとVBAを使ったちゃんとした差し込み印刷」のコードを紹介したいと思います!

環境

Excel 2019 64bit

※テストはしておりませんが、特に変なこともしていないのでどのバージョンでも動くと思います。

仕様

差込先のテンプレート

差し込み先となるテンプレートとして、このようなシートを準備しました。

f:id:shinmai_papa:20201019134348p:plain

実際にご自身でお使いになる場合には、差し込み先のテンプレートをご自身の実現したいテンプレートに置き換えてください。

その際、差し込む場所を特定するため、差し込みデータの項目名を「<<」と「>>」で挟んで記入しておきます。

ここでは便宜的に項目名をエスケープするため、「<<」と「>>」を使っていますが、項目名のエスケープ記号は何でも大丈夫です。

ただし、実際の項目名と干渉するようなエスケープ記号(例えば単純なカッコなど)は避けてください。

ここではコードを単純化するため、項目名は1セルに1つだけとします。

複数の項目名を横並びにしたい場合はセルを分けてください。

この記事では複数の項目を1つのセルにまとめるケースについては紹介しませんが、

コードを改造する場合には正規表現などを駆使して実現することができます。

差し込み先テンプレートのシート名は「template」とします。

また、この記事では、テンプレートの範囲は上から下に必要な分だけ準備する方法を取っています。

差込元のデータ

差し込むデータは「data」というシート名で同じブックに準備します。

f:id:shinmai_papa:20201019134353p:plain

1行目が項目名で、2行目以降が実際のデータになります。

ここでは同じブックに差し込みデータを準備していますが、

コードを少し改造すれば他のブックに保存しておくことも可能です。

注意点

差し込みデータが多い場合、Excelの行数と列数に注意してください。

差し込み先のテンプレートは1つのテンプレートが複数行、桁になるので、

差し込み元のデータが多く、差し込み先テンプレートをたくさん作る場合は

テンプレートがExcelの最大行、桁を超えないように注意してください。

Excel 2007以降なら1,048,576行、16384桁が最大です。

まぁ、そこまで大きなデータを差し込むことはあまりないと思いますが・・・。

コード

Sub insertSample()
    Const TEMPLATE As String = "template"
    Const DATA     As String = "data"
    
    Const STR_RNG As String = "A1:D7"
    
    Application.ScreenUpdating = False
    
    Dim shTemplate As Worksheet: Set shTemplate = Worksheets(TEMPLATE)
    Dim shData As Worksheet: Set shData = Worksheets(DATA)
    Dim rngObj As Range
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("差し込み先").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    '列番号を取得
    Dim collData As Collection: Set collData = New Collection
    Dim lastCol As Long: lastCol = shData.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim i As Long
    For i = 1 To lastCol
        On Error Resume Next
        collData.Add Item:=i, Key:=shData.Cells(1, i).Value
        On Error GoTo 0
    Next i
    
    'データを差し込む
    Dim lngTargetRow As Long
    Dim strKey As String
    Dim lngLastRow As Long: lngLastRow = shData.Cells(Rows.Count, 1).End(xlUp).Row
    
    '新しい差し込み用シートを用意する
    Dim shNew As Worksheet
    shTemplate.Copy after:=Worksheets(DATA)
    Set shNew = ActiveSheet
    shNew.Name = "差し込み先"
    
    Dim rngNewSh As Range
    Set rngNewSh = shNew.Range(STR_RNG)
    
    Dim lngOffset As Long: lngOffset = Range(STR_RNG).Rows.Count
    
    For lngTargetRow = 2 To lngLastRow
        
        For Each rngObj In rngNewSh
            '差し込み先かどうか判定
            If rngObj.Value Like "<<*>>" Then
                strKey = Replace(Replace(rngObj.Value, "<<", ""), ">>", "")
                rngObj.Value = shData.Cells(lngTargetRow, collData(strKey))
            End If
        Next rngObj
        
        '差し込み先シートの値が入っているセル範囲を取得する
        Set rngNewSh = rngNewSh.Offset(lngOffset).Range(STR_RNG)
        
    Next lngTargetRow
    
    Application.ScreenUpdating = True
    
End Sub

コードの解説

Const TEMPLATE As String = "template"
 Const DATAAs String = "data"

シート名を定数にしておきます。

シート名は環境に合わせて変更してください。

 ConstSTR_RNG as String = "A1:D7"

ここがこのコードのキモになります。

1つのテンプレートの範囲を文字列で指定します。

例えば今回の例では、1つのテンプレートが下記の範囲なのでA1:D7を指定しています。

f:id:shinmai_papa:20201019134343p:plain

Application.ScreenUpdating = False

セルへのデータ転記が多くなるので、画面更新を停止しておきます。

Dim shTemplate As Worksheet: Set shTemplate = Worksheets(TEMPLATE)
Dim shData As Worksheet: Set shData = Worksheets(DATA)
Dim rngObj As Range

各変数の準備、ワークシートを変数に割り当てます。

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("差し込み先").Delete
Application.DisplayAlerts = True
On Error GoTo 0

差し込んだ結果となるワークシートを用意します。

「On Error Resume Next」はエラーを無視します。

「On Error GoTo 0」はエラー処理を既定のエラー処理に戻します。

「Application.DisplayAlerts = False」で警告の表示を抑制します。

これをFalseにしておかないと、このような警告が出ます。

f:id:shinmai_papa:20201019134336p:plain

'列番号を取得
Dim collData As Collection: Set collData = New Collection
Dim lastCol As Long: lastCol = shData.Cells(1, Columns.Count).End(xlToLeft).Column
Dim i As Long
For i = 1 To lastCol
   On Error Resume Next
   collData.Add Item:=i, Key:=shData.Cells(1, i).Value
   On Error GoTo 0
Next i

これ以降のコードで、データを扱う際に楽をするために、データの項目名と列数をマッピングしておきます。

この手法について詳しくはこちらの記事をご参照ください。

Excel VBAで表の列名とセルの列番号のスマートなマッピング方法 - 適材適所

'データを差し込む
Dim lngTargetRow As Long
Dim strKey As String
Dim lngLastRow As Long: lngLastRow = shData.Cells(Rows.Count, 1).End(xlUp).Row
'新しい差し込み用シートを用意する
Dim shNew As Worksheet
shTemplate.Copy after:=Worksheets(DATA)
Set shNew = ActiveSheet
shNew.Name = "差し込み先"

変数とシートを準備します。

Dim rngNewSh As Range
Set rngNewSh = shNew.Range(STR_RNG)

1つのテンプレートの範囲を変数に格納しておきます。

Dim lngOffset As Long: lngOffset = Range(STR_RNG).Rows.Count

先ほどのrngNewSh変数の起点となるセルを移動させるための移動量を求めています。

うまく表現できているかどうか・・・。

よくわからないかと思いますのでは、実際にコードを実行いただき、挙動を確認してみてください。

For lngTargetRow = 2 To lngLastRow
      For Each rngObj In rngNewSh
      '差し込み先かどうか判定
      If rngObj.Value Like "<<*>>" Then
         strKey = Replace(Replace(rngObj.Value, "<<", ""), ">>", "")
         rngObj.Value = shData.Cells(lngTargetRow, collData(strKey))
      End If
   Next rngObj
   '差し込み先シートの値が入っているセル範囲を取得する
   Set rngNewSh = rngNewSh.Offset(lngOffset).Range(STR_RNG)
Next lngTargetRow

ここは、前回の差し込み印刷の方法と同じです。

1つだけ異なるのは、テンプレートの範囲を繰り返しごとに移動させている点です。

Set rngNewSh = rngNewSh.Offset(lngOffset).Range(STR_RNG)

ここがこのコードのキモ2です。

OffsetプロパティはRange型を返します。

Range型には、Rangeプロパティがあります。

f:id:shinmai_papa:20201019134339p:plain

このRangeプロパティ、何かというと、そのセルを起点としたRange(範囲)を示しています。

ここでは、rngNewSh.Offset(lngOffset)のセルを起点として、STR_RNGの範囲です。

イメージとしては、繰り返し毎にセル範囲が移動していくような感じです・・・。

と説明してみましたが、ここも中々文章では意味が通じづらいかと思います

実際にコードを実行頂き、変数の中身など挙動を見てもらうのが良いかと思います。

あとは、これがデータシートのレコードの数だけ実行されていきます。

Application.ScreenUpdating = True

最後に画面の停止を解除して終了です。

差し込み印刷とか書いてますが、印刷処理は任意で入れてみてください。

終わりに

差し込み印刷をExcelとVBAで実現することができました。

え?ここまでやるならWordを使った方が早い??

あーあー、聞こえない聞こえない!!

だって作表はやっぱりWordよりExcelの方が楽なんですもの。

しかもWordを挟むとか面倒じゃないですか・・・。

やっぱりExcelオールインワンで実現したいですよね?ね?

ということでExcelとVBAで差し込み印刷をやってみました。

ここまでお読みいだだき、ありがとうございました。

関連する記事

www.tekizai.net