のし書き作成のための印刷テンプレートを作ります。
作成のために設定される項目はたくさんあります。
このたくさんの設定項目のために、組み立てるVBAコードが煩雑なものにならないように注意が必要です。
こんにちは、じゅんぱ店長(@junpa33)です。
この記事では、「のし書き作成エクセルソフト」の「設定」シートで選んだ、
「この、のし書きはこの形で」という
指定された項目の通りに作成できる様に、印刷テンプレートのVBAコードを組み立てていきます。
コンテンツ
のし書き印刷用テンプレートをVBAコードで作る
実際に使う場合、その時々でのし書きの表書きや書式が変わりますので、
基本、幅広く対応できるエクセルVBAのコード組み立てが必要になってきます。
「〇〇の場合は✖✖」、「今回の〇〇は△△」とか、
条件分岐によって結果を変えることも必要になってきます。
また、書式様式の変更などによる、エクセルVBAコードの追加修正が必要になった場合のため、
メンテナンスが行い易いエクセルVBA構造にしておく必要もあります。
印刷テンプレートVBAコード作成のポイント
- のしサイズによる条件分岐
- → のしサイズ(5種類)による、エクセルVBAコードの5つを区別
- → のしサイズ別のコード設計
- → 印刷サイズ、印刷範囲指定
- → セル位置(印刷位置)設定
- → 贈り主表示位置
- → 贈り主併記位置処理
- → 文字フォント、サイズ、表示スタイル
- → プリントプレビュー
サイズ別のエクセルVBAコードの動作に移ってからは、
それぞれ指定された項目の実行のためのエクセルVBAは、パーツ化プロシージャーを呼び出しての実行にします。
つまり、
同じモジュールシート内ですが、それぞれのプロシージャーを跨いでの変数値の共有が必要になります。
ここの作業で設定する変数は、モジュール内(Module1)で共通して使えるようにします。
まずは、モジュールシート(Module1)の先頭に記述しておきます。
ここから順番にコピーペーストで、Module1にコードを張り付けていくことで、この記事内容のコードが完了します。
Option Explicit
Dim SV As String, ONa(3) As String, ONS As String, KNa As String
Dim FNa As String, Msei As String, FSia As Long, FSib As Long
Dim Heiki As Long
Dim Ra As Long, Ca As Long, Rb As Long, Cb As Long, RaP As Long
項目で指定した内容に対する動作は、その動作ごとにプロシージャーを設定します。
各プロシージャーでのVBAコードの組み立て
印刷用テンプレート作成の起動ボタン(コマンドボタン)に対応するプロシージャーは「熨斗テンプレートベースB」プロシージャーになります。
熨斗テンプレベースA プロシージャー
のし印刷テンプレートのベースづくりです。
のし書きBaseシートが存在しない場合は、Sheetタブの一番左位置に新しく作成します。
のし書きBaseシートの用紙設定を行います。
シートの存在確認については、この記事を参考にしてください。
With~End Withの使い方については、この記事を参考にしてください。
'のし印刷テンプレートのベースづくり
Sub 熨斗テンプレベースA()
'のし書きBaseシートが存在するかどうか
Dim Sh As Worksheet
Dim Flg As Boolean
Flg = False
For Each Sh In Worksheets
If Sh.Name = "のし書きBase" Then
Flg = True
Exit For
End If
Next
'存在しなければのし書きBaseシートを新規作成
If Flg = False Then
Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = "のし書きBase"
End If
'のし書きBaseシートをセットアップしていく
Worksheets("のし書きBase").Activate
With Worksheets("のし書きBase")
.Rows("1:57").RowHeight = 13.5
.Columns("A:BK").ColumnWidth = 2
.Cells.MergeCells = False
With .PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.CentimetersToPoints(2)
.RightMargin = Application.CentimetersToPoints(2)
.TopMargin = Application.CentimetersToPoints(0.5)
.BottomMargin = Application.CentimetersToPoints(0.5)
End With
End With
End Sub
設定決め プロシージャー
それそれに設定した項目を変数に代入していきます。
For~Nextの使い方については、この記事も参考にしてください。
エクセルVBA!For~Nextのループと入れ子構造をVBA最速理解
Offsetの使い方はこの記事を参考にしてください。
Sub 設定決め()
Dim k As Long
Worksheets("設定").Activate
'熨斗サイズを変数に代入
SV = Range("I25")
'送り主名入れ表書きを変数に代入
Range("I27:I29").ClearContents
Range("I27").Activate
For k = 4 To 8
If Cells(k, 5).Value = True Then
With ActiveCell
.Value = Cells(k, 6)
.Offset(1).Select
End With
End If
Next k
ONa(1) = Range("I27")
ONa(2) = Range("I28")
ONa(3) = Range("I29")
'贈り主名印字スタイル 縦位置を変数に代入
ONS = Range("I31")
'慶弔名表書きを変数に代入
KNa = Range("I33")
'文字フォント種を変数に代入
If Range("I35") = "" Then
FNa = "MS Pゴシック"
Else
FNa = Range("I35")
End If
'文字の制御を変数に代入
Msei = Range("I37")
'贈り主名併記を変数に代入
If Range("I39") = "併記しない" Then
Heiki = 1
ElseIf Range("I39") = "2人併記" Then
Heiki = 2
ElseIf Range("I39") = "3人併記" Then
Heiki = 3
Else
Heiki = 1
End If
'文字フォントサイズを変数に代入
If Range("I41") = "" Then
FSia = 33
Else
FSia = Range("I41")
End If
If Range("I43") = "" Then
FSib = 33
Else
FSib = Range("I43")
End If
Range("A1").Select
End Sub
熨斗テンプレートベースB プロシージャー
先に作成した熨斗テンプレートを、選択された用紙サイズ設定に合わせて調整していきます。
指定された用紙サイズ別のプロシージャーに動作が移っていきます。
Sub 熨斗テンプレベースB()
Call Module1.熨斗テンプレベースA
With Worksheets("のし書きBase")
.Range("A1:BK16").VerticalAlignment = xlCenter
.Cells.ClearContents
'項目で選択されたフォントの種類をセットします
.Cells.Font.Name = "" & FNa & ""
End With
Call 結び切り修正
If SV = "A5サイズ" Then
Call Module1.A5サイズ版
ElseIf SV = "A4サイズ" Then
Call Module1.A4サイズ版
ElseIf SV = "B5サイズ" Then
Call Module1.B5サイズ版
ElseIf SV = "B4サイズ" Then
Call Module1.B4サイズ版
ElseIf SV = "熨斗封筒" Then
Call Module1.封筒版
End If
Range("A1").Select
End Sub
文字印字位置、文字の制御のためのプロシージャー
文字の表示位置や配置については、それを設定するプロシージャーを呼び出して設定するようにします。
上詰め プロシージャー
Sub 上詰め()
With Worksheets("のし書きBase").Range("A17:BK57")
.VerticalAlignment = xlTop
End With
End Sub
中央揃え プロシージャー
Sub 中央揃え()
With Worksheets("のし書きBase").Range("A17:BK57")
.VerticalAlignment = xlCenter
End With
End Sub
下詰め プロシージャー
Sub 下詰め()
With Worksheets("のし書きBase").Range("A17:BK57")
.VerticalAlignment = xlBottom
End With
End Sub
両端揃え プロシージャー
Sub 両端揃え()
With Worksheets("のし書きBase").Range("A17:BK57")
.VerticalAlignment = xlJustify
End With
End Sub
均等割り付け プロシージャー
Sub 均等割り付け()
With Worksheets("のし書きBase").Range("A17:BK57")
.VerticalAlignment = xlDistributed
End With
End Sub
折り返し全体 プロシージャー
Sub 折り返し全体()
With Worksheets("のし書きBase").Range("A17:BK57")
.ShrinkToFit = False
.WrapText = True
End With
End Sub
縮小し全体 プロシージャー
Sub 縮小し全体()
With Worksheets("のし書きBase").Range("A17:BK57")
.WrapText = False
.ShrinkToFit = True
End With
End Sub
制御の設定なし プロシージャー
Sub 制御の設定なし()
With Worksheets("のし書きBase").Range("A17:BK57")
.WrapText = False
.ShrinkToFit = False
End With
End Sub
贈り主縦位置 プロシージャー(文字印字位置)
「贈り主縦位置」で選択した項目内容を実行するプロシージャーです。
If条件文で条件によって結果を分岐させます。
Sub 贈り主縦位置()
Worksheets("設定").Select
'贈り主名印字スタイル 縦位置を変数に代入
If ONS = "上詰め" Then
Call 上詰め
ElseIf ONS = "中央揃え" Then
Call 中央揃え
ElseIf ONS = "下詰め" Then
Call 下詰め
ElseIf ONS = "両端揃え" Then
Call 両端揃え
ElseIf ONS = "均等割り付け" Then
Call 均等割り付け
End If
End Sub
贈り主文字の制御 プロシージャー(文字の制御)
「贈り主文字の制御」で選択した項目内容を実行するプロシージャーです。
If条件文で条件によって結果を分岐させます。
Sub 贈り主文字の制御()
Worksheets("設定").Select
'贈り主名文字の制御を変数に代入
If Msei = "折り返して全体を表示" Then
Call 折り返し全体
ElseIf Msei = "縮小して全体を表示" Then
Call 縮小し全体
ElseIf Msei = "" Then
Call 制御の設定なし
End If
End Sub
結び切り修正 プロシージャー
メッセージボックスを表示して、「結び切りののし紙かどうか」を確認します。
結び切を使わない場合は、贈り主の表示位置を下げる設定になります。
Sub 結び切り修正()
Dim Ans As Long
Ans = MsgBox("結び切りのしを使いますか?", vbYesNo + vbQuestion, "確認")
If Ans = vbNo Then
If Heiki = 2 Then
RaP = 2
ElseIf Heiki = 3 Then
RaP = 4
Else
RaP = 1
End If
Else
RaP = 0
End If
End Sub
複数併記スペース プロシージャー
贈り主の併記がある場合の印刷位置設定をします。
Sub 複数併記スペース()
With Worksheets("のし書きBase")
.Activate
.Cells.Orientation = xlVertical
'併記しない、1人の場合
If Heiki = 1 Then
With Range(Cells(Ra, Ca), Cells(Rb, Cb))
.Merge
.Value = ONa(1)
.Font.Size = FSib
End With
'2人併記の場合
ElseIf Heiki = 2 Then
With Range(Cells(Ra + RaP, Ca - 2), Cells(Rb, Cb - 2))
.Merge
.Value = ONa(1)
.HorizontalAlignment = xlRight
.Font.Size = FSib
End With
With Range(Cells(Ra + RaP, Ca + 2), Cells(Rb, Cb + 2))
.Merge
.Value = ONa(2)
.HorizontalAlignment = xlLeft
.Font.Size = FSib
End With
'3人併記の場合
ElseIf Heiki = 3 Then
If SV = "熨斗封筒" Then
With Range(Cells(Ra + RaP, Ca), Cells(Rb, Cb))
.Merge
.Value = ONa(1)
.Font.Size = FSib
End With
With Range(Cells(Ra + RaP, Ca - 3), Cells(Rb, Cb - 3))
.Merge
.Value = ONa(2)
.HorizontalAlignment = xlRight
.Font.Size = FSib
End With
With Range(Cells(Ra + RaP, Ca + 3), Cells(Rb, Cb + 3))
.Merge
.Value = ONa(3)
.HorizontalAlignment = xlLeft
.Font.Size = FSib
End With
Else
With Range(Cells(Ra + RaP, Ca), Cells(Rb, Cb))
.Merge
.Value = ONa(1)
.Font.Size = FSib
End With
With Range(Cells(Ra + RaP, Ca - 4), Cells(Rb, Cb - 4))
.Merge
.Value = ONa(2)
.HorizontalAlignment = xlRight
.Font.Size = FSib
End With
With Range(Cells(Ra + RaP, Ca + 4), Cells(Rb, Cb + 4))
.Merge
.Value = ONa(3)
.HorizontalAlignment = xlLeft
.Font.Size = FSib
End With
End If
End If
End With
End Sub
のし紙サイズ別 プロシージャー
A5、A4、B4、B5、熨斗封筒 のそれぞれのサイズについて、それぞれに動作するプロシージャーを設計します。
A5サイズ版 プロシージャー
Sub A5サイズ版()
With Worksheets("のし書きBase")
'A5サイズにサイズセット
.PageSetup.PrintArea = "A1:AG31"
.PageSetup.PaperSize = xlPaperA5
End With
'送り主表記セル位置を変数に代入
Ra = 19
Ca = 16
Rb = 31
Cb = 19
With Range("P1:S12")
.Merge
.Value = KNa
.Font.Size = FSia
.ShrinkToFit = True
End With
Call 複数併記スペース
Call 贈り主縦位置
Call 贈り主文字の制御
'プリントプレビューを表示します
Worksheets("のし書きBase").PrintPreview
End Sub
A4サイズ版 プロシージャー
Sub A4サイズ版()
With Worksheets("のし書きBase")
'A4サイズにサイズセット
.PageSetup.PrintArea = "A1:AX46"
.PageSetup.PaperSize = xlPaperA4
End With
'送り主表記セル位置を変数に代入
Ra = 28
Ca = 24
Rb = 45
Cb = 27
With Range("X2:AA19")
.Merge
.Value = KNa
.Font.Size = FSia
.ShrinkToFit = True
End With
Call 複数併記スペース
Call 贈り主縦位置
Call 贈り主文字の制御
'プリントプレビューを表示します
Worksheets("のし書きBase").PrintPreview
End Sub
B5サイズ版 プロシージャー
Sub B5サイズ版()
With Worksheets("のし書きBase")
'B5サイズにサイズセット
.PageSetup.PrintArea = "A1:AP39"
.PageSetup.PaperSize = xlPaperB5
End With
'送り主表記セル位置を変数に代入
Ra = 25
Ca = 20
Rb = 38
Cb = 23
With Range("T2:W16")
.Merge
.Value = KNa
.Font.Size = FSia
.ShrinkToFit = True
End With
Call 複数併記スペース
Call 贈り主縦位置
Call 贈り主文字の制御
'プリントプレビューを表示します
Worksheets("のし書きBase").PrintPreview
End Sub
B4サイズ版 プロシージャー
Sub B4サイズ版()
With Worksheets("のし書きBase")
'B4サイズにサイズセット
.PageSetup.PrintArea = "A1:BK57"
.PageSetup.PaperSize = xlPaperB4
End With
'送り主表記セル位置を変数に代入
Ra = 35
Ca = 30
Rb = 56
Cb = 33
With Range("AC2:AH22")
.Merge
.Value = KNa
.Font.Size = FSia
.ShrinkToFit = True
End With
Call 複数併記スペース
Call 贈り主縦位置
Call 贈り主文字の制御
'プリントプレビューを表示します
Worksheets("のし書きBase").PrintPreview
End Sub
封筒版 プロシージャー
Sub 封筒版()
With Worksheets("のし書きBase")
'B4サイズにサイズセット
.PageSetup.PrintArea = "A1:BK57"
.PageSetup.PaperSize = 267
.PageSetup.Orientation = xlPortrait
End With
'送り主表記セル位置を変数に代入
Ra = 24
Ca = 4
Rb = 38
Cb = 6
With Range("D2:F15")
.Merge
.Value = KNa
.Font.Size = FSia
.ShrinkToFit = True
End With
Call 複数併記スペース
Call 贈り主縦位置
Call 贈り主文字の制御
'プリントプレビューを表示します
Worksheets("のし書きBase").PrintPreview
End Sub
のし書き印刷用テンプレート
エクセルVBAコードのまとめ
のし書き作成のための印刷用テンプレートについての
エクセルVBAコードの組み立て方法を説明してきました。
用紙サイズが5種類
表書き名が多種
贈り主が複数人を考慮
文字フォント、文字サイズを多種選択可能
等々
選択条件が多くありますので、VBAコードをどのようにまとめるかがポイントです。
考え方としては、
まず、指定された用紙サイズで、印刷用テンプレートを作成するという一連の大きな流れのVBAコードを、
用紙サイズごとにプロシージャーとしてまとめておきます。
別に、選択された項目に対応するVBAコードを、プロシージャーとして記述します。パーツ化しておきます。
指定された用紙サイズの作成プロシージャーの中で、
順番に、選択された指定項目に対応するパーツ化プロシージャーを呼び出し実行していく
という形で、テンプレートを完成させていきます。
これでテンプレートが完成し、プリントプレビューが表示されますので、
印刷ボタンを押せば完了です。
次回は、作成したのし書き印刷テンプレートシートを再利用できるようにするための
保存の方法についてエクセルVBAコードの説明をしたいと思います。
このサイトでよく使うVBAのコードのトピックを纏めています。
今回の記事はここまでです。 最後までご覧いただき有難うございました。