単独印刷のマルチページ。16種類に対応したテンプレ作成

fuutotandokueyecatch

封筒サイズの数だけのテンプレートを作るのではなく、指定されたサイズのテンプレートのみをその都度作成します。セルサイズを細かく設定変更する変数の設置がポイントです。

こんにちは、じゅんぱ店長（@junpa33）です。

マルチページの単独印刷ページについて仕上げていきます。ここでの重要な内容は印刷テンプレートの作り方についてです。

16種類あるサイズそれぞれに対応した、宛名の印刷位置の設定が必要です。

単純には、16種類のテンプレートを作成すればよいのですが、あまり楽しくはありません。

宛名印刷する項目は確定していますので、選択した封筒サイズに合わせてその都度、印刷位置が可変するテンプレートを作成することで進めて行きます。

この説明の前に、先回の記事を確認されたいという場合は、こちら↓になります。

fuutoatesakilisteyecatch マルチページ内に入力フォームを設置して宛名リストを作る

単独印刷ページに各コントロールをレイアウト

tandokuinsatup011

仕上がりはこのようになります。

tandokuinsatu001
  • マルチページに「単独印刷ページ」を設置しコントロールを配置します。
  • ユーザーフォームモジュールにコードを記述します。
  • ボタンから呼び出されるプロシージャーをModule1に記述する。
POINT

封筒宛名を印刷するときに、封筒サイズ種類分のテンプレートを作ることはしません。その都度、指定された封筒サイズに合ったテンプレートを生成し印刷を行います。

目次へ戻る

単独印刷用のコマンドボタンの設置

tandokuinsatup012

いつものようにツールボックスから必要なコントロールを選んで、マルチページ上で展開します。

コマンドボタンの設置とプロパティ

青矢印の部分です。

各コントロールのプロパティはこのようになります。その他の文字コメントはラベルを使って作成してください。

tandokuinsatu002a
①マルチページ「単独印刷」タブ

tandokuinsatu003

②ラベル「プリンター注意」
tandokuinsatu004
③ラベル「宛名確認表示」

tandokuinsatu005
オブジェクト名　「単独印刷」
Caption　「単独印刷」		オブジェクト名　「プリンター注意」
Caption　「（空白）」		オブジェクト名　「宛名確認表示」
Caption　「ここをクリックすると最新に更新します。」
④コマンドボタン「セル戻る」

tandokuinsatu006
⑤コマンドボタン「セル進む」
tandokuinsatu007
⑥ラベル「用紙注意」

tandokuinsatu008
オブジェクト名　「セル戻る」
Caption　「戻る↑」		オブジェクト名　「セル進む」
Caption　「次へ↓」		オブジェクト名　「用紙注意」
Caption　「（白紙）」
⑧コマンドボタン「宛名編集」

tandokuinsatu009
⑨コマンドボタン「印刷プレビュー」

tandokuinsatu010
オブジェクト名　「宛名編集」
Caption　「宛名編集」		オブジェクト名　「印刷プレビュー」
Caption　「印刷確認」

フォームモジュールでのコード記述

「宛名印刷設定」ユーザーフォームモジュールにコントロールのコードを記述します。

②ラベル「プリンター注意」 ⑥ラベル「用紙注意」

封筒サイズをオプションボタンで選択したときに「注意書き」を表示するかどうかのコードが記述されています。

先回の記事で確認できます。

マルチページを使ったエクセル封筒印字ソフトの作成！宛名リスト編を参考にしてください。

オプションボタンのコード設定

③ラベル「宛名確認表示」

宛名リストで今、選択している印刷宛名を表示します。

vbawithstateeyecatch With～End Withの使い方。VBAコードを簡潔に記述する
VBA
Private Sub 宛名確認表示_Click()
        With Worksheets("宛名リスト")
            宛名印刷設定.宛名確認表示.Caption = _
                            .Range("B" & ActiveCell.Row)
        End With
        Worksheets("宛先").Select
End Sub

④コマンドボタン「セル戻る」

Module1に記述されている「セル移動戻る」プロシージャーを呼び出します。

vbacalleyecatch 部品化プロシージャーでCallステートメントは必須
VBA
Private Sub セル戻る_Click()
        Call Module1.セル移動戻る
End Sub

⑤コマンドボタン「セル進む」

Module1に記述されている「セル移動進む」プロシージャーを呼び出します。

VBA
Private Sub セル進む_Click()
        Call Module1.セル移動進む
End Sub

⑧コマンドボタン「宛名編集」

Module1に記述されている「単独印刷」プロシージャーを呼び出します。

VBA
Private Sub 宛名編集_Click()
        Call Module1.単独印刷
End Sub

⑨コマンドボタン「印刷プレビュー」

Module1に記述されている「単独印刷PV」プロシージャーを呼び出します。

VBA
Private Sub 印刷プレビュー_Click()
        Call Module1.単独印刷PV
End Sub
目次へ戻る

Module1のコマンド関連プロシージャー

tandokuinsatup013

コマンドボタンなどから呼び出されるプロシージャーを、Module1に記述していきます。

「セル移動戻る」プロシージャー

アクティブセルを一行戻します。

VBA
Sub セル移動戻る()
        With Worksheets("宛名リスト")
            .Select
            If ActiveCell.Row - 1 = 0 Then
                Exit Sub
            End If
            .Range("B" & ActiveCell.Row - 1).Select
            宛名印刷設定.宛名確認表示.Caption = ActiveCell.Value
        End With
End Sub

「セル移動進む」プロシージャー

アクティブセルを一行下げます。

vbaoffseteyecatch Offsetプロパティは指定範囲を移動させる
VBA
Sub セル移動進む()
        With Worksheets("宛名リスト")
            .Select
            If ActiveCell.Row = Rows.Count Then
                Exit Sub
            End If
            .Range("B" & ActiveCell.Row).Offset(1, 0).Select
            宛名印刷設定.宛名確認表示.Caption = ActiveCell.Value
        End With
End Sub

「単独印刷」プロシージャー

今回の記事の中心部になります。

◎印刷したい宛名を指定する方法は。「宛名リスト」で宛名を選択（セルをアクティブに）するだけです。特に確定ボタンなども作っていません。

◎変数を使ってセルのサイズを変化させます。モジュール内で使えるように記述の先頭で宣言しています。

先回の記事↓で確認できます。

fuutouatenaeyecatch002 封筒宛名印刷のVBA作成。基本部のユーザーフォーム

「「封筒宛名印刷コントロール」フォーム中のコントロールから」です

変数は小数点を扱えるようにDouble（Singleでもいいかもしれませんが）で宣言しています。

変数宣言コード

Public TPnU, TPnL, TPnM, TPnRo As Double

それぞれの変数の意味はこのようにしています。

変数名説明
TPｎU先頭行の高さを調整するための変数
TPｎLA列の幅を調整するための変数
TPｎMフォントサイズを調整するための変数
TPｎRo全行の高さを調整するための変数

封筒の宛名印刷の項目を変数として設定するコード

最初に、選択した宛名の項目別データを変数に代入します。

この変数は「「封筒宛名印刷コントロール」フォーム中のコントロールから」に宣言しているものです。

変数宣言コード

Public STY As Variant

Public aR, J As Long

Public aN, aKei, aSho, aYB, aK, aSK, aB, aBM, aRe As Variant

アクティブにした宛名セルからその同一行の氏名、郵便番号、住所、連絡番号等を印刷用データとして変数に代入します。

VBA
Sub 単独印刷()
        STY = 宛名印刷設定.TP_no.Caption
        Worksheets("宛名リスト").Select
            aR = ActiveCell.Row
            aN = Range("B" & aR).Value
            aKei = Range("C" & aR).Value
            aSho = Range("D" & aR).Value
            aYB = Range("E" & aR).Value
            aK = Range("F" & aR).Value
            aSK = Range("G" & aR).Value
            aB = Range("H" & aR).Value
            aBM = Range("I" & aR).Value
            aRe = Range("J" & aR).Value

封筒タイプ別に変数に数値を設定する

基本は横書きの設定ですが、「STY＝TP1」と「STY＝TP2」と「STY＝TP3」の時に縦書きを選択できるようになっています。

VBAGotoeyecatch001 Gotoステートメントでコードをジャンプ！毒と薬の2面性
VBA
        TPnRo = 1
        If STY = "TP1" Then
            If 宛名印刷設定.横書き2 = True Or _
                        宛名印刷設定.横書き3 = True Then
                STY = "TP1y"
                TPnU = 1
                TPnL = 1
                TPnM = 1
            Else
                TPnU = 1
                TPnL = 1
                TPnM = 1
                TPnRo = 0.67
                Call Module1.縦書き
                GoTo step1
            End If
        ElseIf STY = "TP2" Then
            TPnU = 2.5
            TPnL = 1
            TPnM = 1
            Call Module1.縦書き
            GoTo step1
        ElseIf STY = "TP3" Then
            If 宛名印刷設定.横書き1 = True Then
             STY = "TP3y"
                TPnU = 2.5
                TPnL = 2
                TPnM = 1
            Else
                TPnU = 2.5
                TPnL = 2
                TPnM = 1
                Call Module1.縦書き
                GoTo step1
            End If
        ElseIf STY = "TP4" Then
            TPnU = 7
            TPnL = 3
            TPnM = 1.2
        ElseIf STY = "TP5" Then
            TPnU = 4.5
            TPnL = 1.7
            TPnM = 1.2
        ElseIf STY = "TP6" Then
            TPnU = 2
            TPnL = 1
            TPnM = 1
            TPnRo = 1
            Call Module1.縦書き
            GoTo step1
        ElseIf STY = "TP7" Then
            TPnU = 5.5
            TPnL = 8
            TPnM = 1.5
            TPnRo = 1.5
        ElseIf STY = "TP8" Then
            TPnU = 5.5
            TPnL = 6
            TPnM = 1.5
            TPnRo = 1.5
        ElseIf STY = "TP9" Then
            TPnU = 4.5
            TPnL = 5
            TPnM = 1.5
            TPnRo = 1.5
        ElseIf STY = "TP10" Then
            TPnU = 3
            TPnL = 3.5
            TPnM = 1.5
            TPnRo = 1.5
        Else
            MsgBox "封筒サイズが指定されていません。", _
                        vbOKOnly, "封筒宛名印刷"
            Exit Sub
        End If

横書きの場合の表示（「宛先」シートに表示）コード

続いて以下のコードがつながっていきます。

宛名項目のデータが表示されるセル番号は一定で、主に、そのセルの上隣りや左隣のセルのサイズを変化させることで、各用紙での印字位置を調整しています。

vbacleareyecatch シートクリアーを目的のメソッド別にVBA最速理解 vbacellsfonteyecatch 「フォント」の操作を最速理解する エクセルVBA vbacellsplacementeyecatch 「配置」を最速理解する エクセルVBA
VBA
        With Worksheets("宛先")
            With .Cells
                .ClearFormats
                .ClearContents
                .UseStandardHeight = True
                .UseStandardWidth = True
            End With
            With .PageSetup
                .CenterHorizontally = False
                .TopMargin = Application.CentimetersToPoints(1.5)
                .LeftMargin = Application.CentimetersToPoints(0.5)
                .RightMargin = Application.CentimetersToPoints(0.5)
                .BottomMargin = Application.CentimetersToPoints(1.5)
            End With
            .Rows.RowHeight = 24 * TPnRo
            .Columns(1).ColumnWidth = 4.5 * TPnL
            .Columns(6).ColumnWidth = 4.5
            .Cells.Font.Size = 15 * TPnM
            .Cells.ShrinkToFit = True
            .Rows(1).RowHeight = 24 * TPnU
            .Range("B2").Value = aYB
            .Range("B4").Value = aK & aSK & aB
            .Range("B5").Value = aBM
            With .Range("B7")
                .Value = aSho
                .Font.Size = 17 * TPnM
                .Font.Bold = True
            End With
            With .Range("B8")
                .Value = aN & "   " & aKei
                .Font.Size = 17 * TPnM
                .Font.Bold = True
            End With
            .Range("B11").Value = aRe
            .Range("B4:E4").MergeCells = True
            .Range("B5:E5").MergeCells = True
            .Range("B7:E7").MergeCells = True
            .Range("B8:E8").MergeCells = True
            .Range("B11:E11").MergeCells = True
        End With
step1:
        Worksheets("宛先").Columns.AutoFit
        Call Module1.フォント設定
End Sub

縦書きの場合の表示コード

縦書きの場合は、別のプロシージャーとして記述し、「単独印刷」プロシージャーの中でこれを呼び出します。

VBA
Sub 縦書き()
        With Worksheets("宛先")
            With .Cells
                .ClearFormats
                .ClearContents
                .UseStandardHeight = True
                .UseStandardWidth = True
            End With
            With .PageSetup
                .TopMargin = Application.CentimetersToPoints(1.5)
                .LeftMargin = Application.CentimetersToPoints(0.5)
                .RightMargin = Application.CentimetersToPoints(0.5)
                .BottomMargin = Application.CentimetersToPoints(1.5)
            End With
            .Rows.RowHeight = 24 * TPnRo
            .Columns("A").ColumnWidth = 3
            .Columns("K").ColumnWidth = 3
            With .Cells
                .Font.Size = 15 * TPnM
                .ShrinkToFit = True
                .Orientation = xlVertical
                .VerticalAlignment = xlTop
            End With
            .Rows(1).RowHeight = 24 * TPnU
            .Range("B:J").ColumnWidth = 3
            .Range("E2").Value = aYB
            .Range("J4").Value = aK & aSK & aB
            .Range("I12").Value = aBM
            With .Range("G5")
                .Value = aSho
                .Font.Size = 17 * TPnM
                .Font.Bold = True
            End With
            With .Range("F5")
                .Value = aN & "  " & aKei
                .Font.Size = 17 * TPnM
                .Font.Bold = True
            End With
            .Range("B22").Value = aRe
            .Range("E2:H2").MergeCells = True
            .Range("J4:J21").MergeCells = True
            .Range("I12:I21").MergeCells = True
            .Range("G5:G21").MergeCells = True
            .Range("F5:F21").MergeCells = True
            .Range("B22:H22").MergeCells = True
            .Range("E2").Orientation = xlHorizontal
            .Range("B22:H22").Orientation = xlHorizontal
        End With
End Sub

「単独印刷PV」プロシージャー

最後にプリントプレビューのコードです。

VBA
Sub 単独印刷PV()
        Worksheets("宛先").PrintPreview
End Sub
目次へ戻る

「単独印刷」マルチページ作成のまとめ

tandokuinsatup014

「単独印刷」プロシージャーの封筒タイプごとの変数の数値設定を調整すれば、より気に入った配置で宛名印刷をすることが出来ると思います。少しずつ数値を変化させながら、プレビュー画面で確認して行くのがコツです。

普通によく使われている方法はこの方法ではなく、

オーソドックスにそれぞれの大きさの封筒のテンプレートを作成して、データを流し込んで印刷するという方法です。

この方法がより簡単だと思います。

ただそれは、封筒のサイズ分だけテンプレートを作らないといけませんし、そのテンプレートにデータを流し込むコードもそれぞれに作らないといけません。

今回は、これだけ多くの封筒の種類を扱っていますので、よりコンパクトに作ろうということで、テンプレートを設置しない方法を採用しました。

ここまで、印刷プレビューを確認しながら一件ずつ印刷するパターンを紹介しましたが、

次回は、印刷範囲を決めて連続で宛名印刷を行うパターンを紹介したいと思います。

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。

vbastudyeyecatch2 エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

今回の記事はここまでです。   最後までご覧いただき有難うございました。

エクセルVBA最速理解で必要な知識を集めよう！

エクセルVBA業務ツールで日常の業務改善を行いましょう。

＜記事内容についての告知＞

VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。

目次へ戻る

アンケートでポイ活しよう!!

アンケートに答えれば答えるほど ”使える” ポイントがたまります。

NTTコム サーチ

af_banner01

Dstyle web

dstyleweb_logo
dstyle_320x50-min

前の記事

fuutoatesakilisteyecatch
マルチページ内に入力フォームを設置して宛名リストを作る

次の記事

連続印刷機能のコード設計。印刷範囲設定や途中終了と停止
fuutorenzokueyecatch