封筒に差出人を簡単に印刷する。VBAコードはタテ印刷ヨコ印刷に対応。

今回の封筒宛名印刷エクセルは、差出人印刷についてです。

特徴は、サイズにわせて縦印刷と横印刷に対応し、また差出人を変更することもできます。

ＳＨＯＰ名で、個人で、ニックネームで出すときなどにも使えます。

今回の作成のポイントは、
この差出人印刷の特徴は、封筒サイズに合わせた縦印刷と横印刷の両対応。
差出人を登録すれば、その差出人を変更できるということです。
例えば、ＳＨＯＰ名で差し出す場合、個人で差し出す場合、ニックネームで差し出す場合などにも利用することが出来ます。

 

1. 「差出名リスト」シートを作成します。最初の登録をスタートとして、差出人名の履歴が積みあがっていくようにします。
2. 印刷する差出人の指定は、リストの差出名のセルを選択（アクティブに）して行います。
3. サイズごとの印刷位置のセッティングは変数を利用してコード作成します。

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

Private Sub 差出入力クリア_Click()

 

宛名印刷設定.差出名.Value = “”
宛名印刷設定.差出所属.Value = “”
宛名印刷設定.差出前3文字.Value = “”
宛名印刷設定.差出後4文字.Value = “”
宛名印刷設定.差出都道府県名.Value = “”
宛名印刷設定.差出市区町村名.Value = “”
宛名印刷設定.差出番地.Value = “”
宛名印刷設定.差出ビルマンション.Value = “”
宛名印刷設定.差出連絡番号.Value = “”

 

End Sub

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

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

Sub 差出フォント設定()

 

Worksheets(“差出”).Select
Cells.Select

 

With Selection.Font
　　If 宛名印刷設定.ComboBox1.ListIndex = 0 Then
　　　　.Name = “ＭＳ Ｐゴシック”
　　ElseIf 宛名印刷設定.ComboBox1.ListIndex = 1 Then
　　　　.Name = “ＭＳ Ｐ明朝”
　　ElseIf 宛名印刷設定.ComboBox1.ListIndex = 2 Then
　　　　.Name = “AR P隷書体M”
　　Else
　　　　.Name = “ＭＳ Ｐゴシック”
　　End If
End With

 

Range(“A1”).Select

End Sub

Sub 差出リスト追加()

 

Dim SDRow As Long

 

　　Workbooks(“封筒宛名印字.xlsm”).Activate
　　Worksheets(“差出名リスト”).Select
　　　　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
　　　　Exit Sub
　　End If

 

　　Range(“B” & SDRow).Select

　　Worksheets(“差出名リスト”).Columns.AutoFit

　　Worksheets(“差出名リスト”).Select

End Sub

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
　　　　　　差出縦書き
　　　　　　GoTo step1
　　　　End If

　　ElseIf STY = “TP2” Then
　　　　TPnU = 5
　　　　TPnL = 0.5
　　　　TPnM = 1.2
　　　　TPnRo = 1.2
　　　　差出縦書き
　　　　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
　　　　　　差出縦書き
　　　　　　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
　　　　差出縦書き
　　　　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

差出フォント設定

差出人名印刷PV

End Sub

Sub 差出縦書き()

 

　　With Worksheets(“差出”)
　　　　.Cells.ClearFormats
　　　　.Cells.ClearContents
　　　　.Cells.UseStandardHeight = True
　　　　.Cells.UseStandardWidth = True
　　　　.PageSetup.LeftMargin = Application.CentimetersToPoints(0.1)
　　　　.PageSetup.RightMargin = Application.CentimetersToPoints(0.5)
　　　　.PageSetup.BottomMargin = Application.CentimetersToPoints(0.5)
　　　　.Rows.RowHeight = 24 * TPnRo
　　　　.Columns(“A”).ColumnWidth = 1.5
　　　　.Columns(“B:Q”).ColumnWidth = 2.3
　　　　.Columns(“R”).ColumnWidth = 3
　　　　.Cells.Font.Size = 13 * TPnM
　　　　.Cells.ShrinkToFit = True
　　　　.Cells.Orientation = xlVertical
　　　　.Cells.VerticalAlignment = xlTop
　　　　.Rows(1).RowHeight = 24 * TPnU
　　　　.Range(“B6”).Value = saYB
　　　　.Range(“F7”).Value = saK & saSK & saB
　　　　.Range(“E7”).Value = saBM
　　　　.Range(“D8”).Value = saSho
　　　　.Range(“D8”).Font.Size = 13 * TPnM
　　　　.Range(“C7”).Value = saN
　　　　.Range(“C7”).Font.Size = 13 * TPnM
　　　　.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
　　　　.Range(“B6”).Orientation = xlHorizontal
　　　　.Range(“B6”).HorizontalAlignment = xlCenter
　　　　.Range(“F7”).VerticalAlignment = xlTop
　　　　.Range(“E7”).VerticalAlignment = xlTop
　　　　.Range(“D8”).VerticalAlignment = xlTop
　　　　.Range(“B7”).VerticalAlignment = xlBottom

　　End With

End Sub

Sub 差出人名印刷PV()

　　Worksheets(“差出”).PrintPreview

End Sub

こちら↓でダウンロードすることが出来ます。

 

ただし、こちらの方はＶＢＡコードを保護していますので、使う側でのＶＢＡコードのカスタマイズを行うことはできません。

 

ここの記事説明とダウンロードしたソフトで、早々に利用していただくことが出来ます。

 

[ダウンロードが見つかりません]

 

このソフトはご自分で業務でお使いいただくのはフリーですが、

転載や転売については許可しておりませんので、ご使用にならないよう固くお断りいたします。

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