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

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

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

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

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

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

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

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

2020年8月27日連続印刷機能のコード設計。印刷範囲設定や途中終了と停止

封筒宛名印刷の記事編成

封筒宛名印刷の使い方とダウンロード
- 封筒宛名印刷エクセルソフトの無料DLと取説

封筒宛名印刷の作成手順

コンテンツ

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

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

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

作成のポイント

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

目次へ戻る

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

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

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

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

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

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

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

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

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

VBA

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

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

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

2020年12月4日 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の「差出人名印刷」プロシージャーを呼び出します。

2022年4月17日部品化プロシージャーでCallステートメントは必須

VBA

Private Sub 差出人印刷_Click()
        Call Module2.差出人名印刷
End Sub

目次へ戻る

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

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

2020年11月6日宣言方法で変数の適用範囲を変えるエクセル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 = "ＭＳ Ｐゴシック"
        End If
        Selection.Font.Name = 宛名印刷設定.ComboBox1.Value
End Sub

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

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

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

2020年12月5日データ入力済セルの最終行番号を取得する

2020年10月27日 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

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

封筒サイズからの設定

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

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

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

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

2020年11月4日 If条件文のVBAコードの組み方。条件の絞り方を最速理解

2020年10月31日 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 = _
                        "長形２号" 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」プロシージャー

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

VBA

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

目次へ戻る

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

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

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

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

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

補足説明

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

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

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

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

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

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

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

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

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

目次へ戻る

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

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

NTTコムサーチ

Dstyle web

②テキストボックス「差出人」	③テキストボックス「利用区分」	④テキストボックス「所属先名」
オブジェクト名　「差出名」	オブジェクト名　「差出利用区分」	オブジェクト名　「差出所属」

⑤テキストボックス「郵便番号」１	⑥テキストボックス「郵便番号」２	⑦テキストボックス「都道府県」
オブジェクト名「差出前3文字」	オブジェクト名「差出後4文字」	オブジェクト名「差出都道府県名」

⑧テキストボックス「市区町村」	⑨テキストボックス「番地」	⑩テキストボックス「ビル・マンション名」
オブジェクト名「差出市区町村名」	オブジェクト名「差出番地」	オブジェクト名「差出ビルマンション」

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