16種類の封筒に差出人を印刷する。タテ・ヨコ印刷に対応

fuutosasidasieyecatch

差出人印刷の「差出人ページ」を作成します。
宛名印刷と同様、サイズにわせ縦横印刷に対応します。また差出人を複数登録できるので、店名、個人名、ニックネームと変更可能です。

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

差出人印刷を行えるようにします。

宛名印刷と同様の手法でコード作成を行います。

差出人リストを作成し、複数の差出人登録で店名・個人名・ニックネームなど複数の使い分けが行えるようにしています。

印刷項目の文字の大きさの再調整が必要な場合は、直接文字サイズやセルサイズを変更してください。

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

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

差出人印刷のマルチページ

fuutosasidasip016

「差出人ページ」はこのようになります。

fuutosasidasi001
  • マルチページを増やして「差出人」ページ(タブ)を作ります。
  • 「差出人」ページに情報入力用にテキストボックスを配置します。
  • 「差出人」ページにコマンドボタンを配置します。
  • ユーザーフォームモジュールにコントロールのイベントコードを記述します。
  • Module2にコマンドボタンから呼び出すプロシージャーを記述します。
作成のポイント

この差出人印刷は、封筒サイズに合わせた縦印刷と横印刷の両方に対応しています。
差出人を複数登録すれば、その都度、差出人を変更することができます。
例えば、SHOP名で差し出す場合、個人で差し出す場合、ニックネームで差し出す場合などにも利用することが出来ます。

「差出人」ページにコントロールを配置

fuutosasidasip017

青矢印と赤矢印が配置したコントロールです。

fuutosasidasi002a

コントロールを配置します

プロパティを確認してください。

配置するテキストボックスのプロパティ

②テキストボックス「差出人」
fuutosasidasi005
③テキストボックス「利用区分」
fuutosasidasi004
④テキストボックス「所属先名」
fuutosasidasi006
オブジェクト名 「差出名」オブジェクト名 「差出利用区分」オブジェクト名 「差出所属」
⑤テキストボックス「郵便番号」1
fuutosasidasi007
⑥テキストボックス「郵便番号」2
fuutosasidasi008
⑦テキストボックス「都道府県」
fuutosasidasi009
オブジェクト名「差出前3文字」オブジェクト名「差出後4文字」オブジェクト名「差出都道府県名」
⑧テキストボックス「市区町村」
fuutosasidasi010
⑨テキストボックス「番地」
fuutosasidasi011
⑩テキストボックス「ビル・マンション名」
fuutosasidasi012
オブジェクト名「差出市区町村名」オブジェクト名「差出番地」オブジェクト名「差出ビルマンション」
⑪テキストボックス「連絡番号」
fuutosasidasi013
オブジェクト名「差出連絡番号」

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

①コマンドボタン「差出人登録」
fuutosasidasi003
⑫コマンドボタン「入力クリア」
fuutosasidasi014
⑬コマンドボタン「差出人印刷」
fuutosasidasi015
オブジェクト名「差出人登録1」
Caption「差出人登録」
オブジェクト名「差出入力クリア」
Caption「入力クリア」
オブジェクト名「差出人印刷」
Caption「差出人印刷」

ユーザーフォームモジュールへのイベントコード記述

①コマンドボタン「差出人登録1」

Module2の「差出リスト追加」プロシージャーを呼び出します。

VBA
Private Sub 差出人登録1_Click()
        Call Module2.差出リスト追加
End Sub

⑫コマンドボタン「差出入力クリア」

入力欄のそれぞれに「 ”” (空白)」を入力します。

vbawithstateeyecatch With~End Withの使い方。VBAコードを簡潔に記述する
VBA
Private Sub 差出入力クリア_Click()
        With 宛名印刷設定
            .差出名.Value = ""
            .差出所属.Value = ""
            .差出前3文字.Value = ""
            .差出後4文字.Value = ""
            .差出都道府県名.Value = ""
            .差出市区町村名.Value = ""
            .差出番地.Value = ""
            .差出ビルマンション.Value = ""
            .差出連絡番号.Value = ""
        End With
End Sub

⑬コマンドボタン「差出人印刷」

Module2の「差出人名印刷」プロシージャーを呼び出します。

vbacalleyecatch 部品化プロシージャーでCallステートメントは必須
VBA
Private Sub 差出人印刷_Click()
        Call Module2.差出人名印刷
End Sub

差出人印刷VBAコードをModule2に記述する

fuutosasidasip018

モジュール内で共通の変数の宣言を先頭に記述します。

vbasengeneyecatch 宣言方法で変数の適用範囲を変える エクセルVBA
VBA
Option Explicit

    Public STY As Variant
    Public TPnU, TPnL, TPnM, TPnRo, TPnCo As Double
    Public saR As Long
    Public saN, saKei, saSho, saYB, saK, saSK, saB, saBM, saRe As Variant

フォント設定について、フォントを「差出」シートでも独自に選択できるようにします。宣言の次にこの記述をしておきます。

VBA
Sub 差出フォント設定()
        Worksheets("差出").Select
        Cells.Select
        If 宛名印刷設定.ComboBox1.Value = "" Then
            宛名印刷設定.ComboBox1.Value = "MS Pゴシック"
        End If
        Selection.Font.Name = 宛名印刷設定.ComboBox1.Value
End Sub

フォントを選択しない場合は、MSPゴシックになります。

「差出リスト追加」プロシージャー

1行目に項目が入ります。差出人を入力する毎にリストが追加されていきます。

vbalastcelleyecatch データ入力済セルの最終行番号を取得する fornextirekoeyecatch For~Nextのループと入れ子構造をVBA最速理解
VBA
Sub 差出リスト追加()
    Dim SDRow, s As Long
        Workbooks("封筒宛名印字.xlsm").Activate
        With Worksheets("差出名リスト")
            .Range("B1") = "差出名"
            .Range("C1") = "利用区分"
            .Range("D1") = "所属先名"
            .Range("E1") = "郵便番号"
            .Range("F1") = "都道府県"
            .Range("G1") = "市区町村"
            .Range("H1") = "番地"
            .Range("I1") = "ビル・マンション名"
            .Range("J1") = "連絡番号"
            SDRow = .Cells(Rows.Count, 2).End(xlUp).Row
            For s = 2 To SDRow + 1
                .Range("A" & s) = s - 1
            Next s
            If 宛名印刷設定.差出名.Value <> "" Then
                .Range("B" & SDRow + 1) = 宛名印刷設定.差出名.Value
                .Range("C" & SDRow + 1) = 宛名印刷設定.差出利用区分.Value
                .Range("D" & SDRow + 1) = 宛名印刷設定.差出所属.Value
                .Range("E" & SDRow + 1) = 宛名印刷設定.差出前3文字.Value _
                            & "-" & 宛名印刷設定.差出後4文字.Value
                .Range("F" & SDRow + 1) = 宛名印刷設定.差出都道府県名.Value
                .Range("G" & SDRow + 1) = 宛名印刷設定.差出市区町村名.Value
                .Range("H" & SDRow + 1) = 宛名印刷設定.差出番地.Value
                .Range("I" & SDRow + 1) = 宛名印刷設定 _
                            .差出ビルマンション.Value
                .Range("J" & SDRow + 1) = 宛名印刷設定.差出連絡番号.Value
            Else
                MsgBox "宛名が未記入です。" & vbCrLf & _
                "登録を中止して終了します。", vbCritical, "封筒宛名印刷"
                Exit Sub
            End If
            .Range("B" & SDRow).Select
            .Columns.AutoFit
            .Select
            .Range("A1").Select
        End With
End Sub

「差出人名印刷」プロシージャー

封筒サイズからの設定

宛名印刷の時と同様に、変数を使ってセルサイズ、フォントサイズを変化させて、各封筒サイズに適応させています。

アクティブセルの行番号をターゲットとして変数に値を代入していきます。

各封筒サイズに合わせたセルの設定

各封筒サイズに割り振られた変数の値によって、セルの大きさ、行高さ、列幅、フォントサイズを決めています。

vbaifjyokeneyecatch If条件文のVBAコードの組み方。条件の絞り方を最速理解 VBAGotoeyecatch001 Gotoステートメントでコードをジャンプ!毒と薬の2面性
VBA
Sub 差出人名印刷()
        Worksheets("差出名リスト").Select
        saR = ActiveCell.Row
        saN = Range("B" & saR).Value
        saKei = Range("C" & saR).Value
        saSho = Range("D" & saR).Value
        saYB = Range("E" & saR).Value
        saK = Range("F" & saR).Value
        saSK = Range("G" & saR).Value
        saB = Range("H" & saR).Value
        saBM = Range("I" & saR).Value
        saRe = Range("J" & saR).Value
'封筒サイズからの設定
        STY = 0
        TPnU = 0
        TPnL = 0
        TPnM = 0
        TPnRo = 0
        TPnCo = 0
        STY = 宛名印刷設定.TP_no.Caption
        If STY = "TP1" Then
            If 宛名印刷設定.横書き2 = True Or 宛名印刷設定 _
                        .横書き3 = True Then
                STY = "TP1y"
                TPnU = 0.7
                TPnL = 1
                TPnM = 0.87
                TPnRo = 0.6
                TPnCo = 1
            Else
                TPnU = 1
                TPnL = 0.5
                TPnM = 1
                TPnRo = 0.87
                Call Module2.差出縦書き
                GoTo step1
            End If
        ElseIf STY = "TP2" Then
            TPnU = 5
            TPnL = 0.5
            TPnM = 1.2
            TPnRo = 1.2
            Call Module2.差出縦書き
            GoTo step1
        ElseIf STY = "TP3" Then
            If 宛名印刷設定.横書き1 = True Then
                STY = "TP3y"
                TPnU = 1
                TPnL = 1
                TPnM = 1.2
                TPnRo = 1
                TPnCo = 1
            Else
                TPnU = 5
                TPnL = 0.5
                TPnM = 1.2
                TPnRo = 1.2
                Call Module2.差出縦書き
                GoTo step1
            End If
        ElseIf STY = "TP4" Then
            TPnU = 6
            TPnL = 1
            TPnM = 1.3
            TPnRo = 1.3
            TPnCo = 1
        ElseIf STY = "TP5" Then
            If 宛名印刷設定.サイズ表示A.Caption = _
                        "長形2号" Then
                TPnU = 5
                TPnL = 0.3
                TPnM = 1.3
                TPnRo = 1.1
                TPnCo = 0.8
            Else
                TPnU = 1
                TPnL = 1
                TPnM = 1.3
                TPnRo = 0.9
                TPnCo = 1
            End If
        ElseIf STY = "TP6" Then
            TPnU = 3
            TPnL = 0.5
            TPnM = 1
            TPnRo = 1.3
            Call Module2.差出縦書き
            GoTo step1
        ElseIf STY = "TP7" Then
            TPnU = 5.5
            TPnL = 2
            TPnM = 2
            TPnRo = 1.4
            TPnCo = 1
        ElseIf STY = "TP8" Then
            TPnU = 2.5
            TPnL = 2
            TPnM = 1.5
            TPnRo = 1.2
            TPnCo = 1
        ElseIf STY = "TP9" Then
            TPnU = 1
            TPnL = 1
            TPnM = 1.5
            TPnRo = 1.1
            TPnCo = 1
        ElseIf STY = "TP10" Then
            TPnU = 1
            TPnL = 1
            TPnM = 1.5
            TPnRo = 1
            TPnCo = 1
        Else
            MsgBox "封筒サイズが指定されていません。", _
                        vbOKOnly, "封筒宛名印刷"
            Exit Sub
        End If
'各封筒サイズに合わせたセルの設定
        With Worksheets("差出")
            .Cells.ClearFormats
            .Cells.ClearContents
            .Cells.UseStandardHeight = True
            .Cells.UseStandardWidth = True
            .PageSetup.CenterHorizontally = False
            .PageSetup.TopMargin = Application _
                                .CentimetersToPoints(2.5)
            .PageSetup.LeftMargin = Application _
                                .CentimetersToPoints(0.25)
            .PageSetup.RightMargin = Application _
                                .CentimetersToPoints(0.5)
            .Rows.RowHeight = 24 * TPnRo
            .Columns(1).ColumnWidth = 4.5 * TPnL
            .Columns.ColumnWidth = 8.38 * TPnCo
            .Cells.Font.Size = 11 * TPnM
            .Cells.ShrinkToFit = True
            .Rows(1).RowHeight = 24 * TPnU
            .Range("B19").Value = saYB
            .Range("B20").Value = saK & saSK & saB
            .Range("B21").Value = saBM
            .Range("B22").Value = saSho
            .Range("B22").Font.Size = 13 * TPnM
            .Range("B22").Font.Bold = True
            .Range("B23").Value = saN
            .Range("B23").Font.Size = 13 * TPnM
            .Range("B23").Font.Bold = True
            .Range("B24").Value = saRe
        End With
step1:
        Worksheets("差出").Columns.AutoFit
         Call Module2.差出フォント設定
         Call Module2.差出人名印刷PV
End Sub

「差出縦書き」プロシージャー

縦書きが必要な封筒サイズのために、別にプロシージャーを記述しています。

VBA
Sub 差出縦書き()
        With Worksheets("差出")
            With .Cells
                .ClearFormats
                .ClearContents
                .UseStandardHeight = True
                .UseStandardWidth = True
            End With
            With .PageSetup
                .LeftMargin = Application _
                                    .CentimetersToPoints(0.1)
                .RightMargin = Application _
                                    .CentimetersToPoints(0.5)
                .BottomMargin = Application _
                                    .CentimetersToPoints(0.5)
            End With
            .Rows.RowHeight = 24 * TPnRo
            .Columns("A").ColumnWidth = 1.5
            .Columns("B:Q").ColumnWidth = 2.3
            .Columns("R").ColumnWidth = 3
            With .Cells
                .Font.Size = 13 * TPnM
                .ShrinkToFit = True
                .Orientation = xlVertical
                .VerticalAlignment = xlTop
            End With
            .Rows(1).RowHeight = 24 * TPnU
            .Range("B6").Value = saYB
            .Range("F7").Value = saK & saSK & saB
            .Range("E7").Value = saBM
            With .Range("D8")
                .Value = saSho
                .Font.Size = 13 * TPnM
            End With
            With .Range("C7")
                .Value = saN
                .Font.Size = 13 * TPnM
            End With
            .Range("B7").Value = saRe
            .Range("B6:F6").MergeCells = True
            .Range("F7:F17").MergeCells = True
            .Range("E7:E17").MergeCells = True
            .Range("D8:D17").MergeCells = True
            .Range("C7:C17").MergeCells = True
            .Range("B7:B17").MergeCells = True
            With .Range("B6")
                .Orientation = xlHorizontal
                .HorizontalAlignment = xlCenter
            End With
            .Range("F7").VerticalAlignment = xlTop
            .Range("E7").VerticalAlignment = xlTop
            .Range("D8").VerticalAlignment = xlTop
            .Range("B7").VerticalAlignment = xlBottom
        End With
End Sub

「差出人名印刷PV」プロシージャー

最後に印刷プレビューの表示です。確認してOKであればプレビュー内の「印刷ボタン」を押します。

VBA
Sub 差出人名印刷PV()
        Worksheets("差出").PrintPreview
End Sub

「差出人を封筒に印刷」のまとめ

fuutosasidasip019

封筒裏面に差出人を印刷する「差出人ページ」設置と関係するVBAコードを作成しました。

コードの設計は、基本的に宛名印刷で作成したものと同様です。

差出人印刷を実行する場合は、印刷プレビューから「印刷」ボタンをクリックして行います。

印刷が複数枚数の場合はここで枚数指定します。

補足説明

最後に、封筒の種類を増やしたいときのコード修正のポイントを挙げておきます。

  1. 「封筒宛名コントロール」のオプションボタンをその封筒サイズ名で増やします。(同じフレーム内に入れてください。)
  2. プリンターへの「封筒登録」を行ってください。
  3. ユーザーフォームモジュールに増やしたオプションボタンのイベントコードを記述します。
  4. 封筒タイプ(現在はTP1からTP10)を増やすかどうかを考えます。現在あるタイプのどれかに入るならそのタイプにします。
  5. 封筒タイプは宛名の印刷位置を規定していますので、増やす場合は、5つの変数TPnU・TPnL・TPnM・TPnRo・TPnCoを設定してください。
  6. Module1で「単独印刷」プロシージャー、Module2で「差出人名印刷」プロシージャー内のタイプ判定コードに対して、その封筒サイズの条件分岐を増やしてください。

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

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

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

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

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

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