設定項目の選択値を整理してVBAコードに反映させる

noshitempeyecatch

のし書きを作るために、設定したデータを整理整頓して、表示形式や印刷設定に反映させていきます。
選択された設定項目がたくさんありますので、部品化プロシージャーを上手く利用していきます。

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

「のし書き作成エクセル」の「設定」シートに表示されている各詳細設定の項目を選択します。

それぞれに設定した項目を整理して「一枚ののし紙」として印刷できるように指示していきます。

この記事では、「詳細設定」の情報を整理整頓するVBAを作成します。

詳細設定で指定した内容をVBAに落とし込む

noshigakitempkai001

選択された設定には、多くの項目がありますので整理整頓しながらコード化していきます。

VBAコードの作成は以下の手順で行っていきます。

  • 「設定」シートの「項目選択済み一覧」から、各項目の決定データを準備された所定のパブリック変数に代入するVBAを作成
  • パブリック変数に代入された決定データを、印刷指示になるように、部品プロシージャーに落とし込みます。
  • のし書きテンプレートのベースとなるVBAコード作成します。

コード記述はModule1で行っていきます。

選択項目を確定し変数に代入

「設定」シートで選択した項目を確定分としてパブリック変数に代入するVBAを作成します。

パブリック変数にする理由として、いくつかの部品プロシージャーをModule内だけでなく、跨いでも作成し、そのプロシージャー内で使用していくためです。

選定したそれぞれの確定項目を書式設定や印刷設定は、個別にプロシージャーを呼び出して行っていきます。

変数使用の宣言

パブリック変数はModule1先頭の宣言セクションで行います。

vbasengeneyecatch 宣言方法で変数の適用範囲を変える エクセルVBA
VBA
Option Explicit
    Dim SV, ONa(3), ONS, KNa As String
    Dim FNa, Msei As String
    Dim FSia, FSib, Heiki As Long
    Dim Ra, Ca, Rb, cb, RaP As Long
    Dim MsgA, MsgB As Long

パブリック変数に値を代入

「設定」シートの項目選択済み一覧に表示された決定項目を、

「決定決め」プロシージャーでパブリック変数に値を代入します。

vbaifjyokeneyecatch If条件文のVBAコードの組み方。条件の絞り方を最速理解 fornextirekoeyecatch For～Nextのループと入れ子構造をVBA最速理解 vbamsgboxeyecatch メッセージボックス MsgBox実際の使い方を最速に理解
VBA
Sub 設定決め()
    Dim k, n As Long
    Dim OLNa(4) As String
        ONa(1) = ""
        ONa(2) = ""
        ONa(3) = ""
        MsgA = 0
        Worksheets("設定").Activate
'熨斗サイズを変数に代入
        Range("I25") = Cells(3 + Range("H25").Value, 3)
        SV = Range("I25")
'贈り主名印字スタイル　縦位置を変数に代入
        Range("I31") = Cells(3 + Range("H31").Value, 9)
        ONS = Range("I31")
'慶弔名表書きを変数に代入
        Range("I33") = Cells(11 + Range("H33").Value, 3)
        KNa = Range("I33")
'文字フォント種を変数に代入
        Range("I35") = Cells(11 + Range("H35").Value, 6)
        If Range("I35") = "" Then
            FNa = "ＭＳ　Ｐゴシック"
        Else
            FNa = Range("I35").Value
        End If
'文字の制御を変数に代入
        Range("I37") = Cells(11 + Range("H37").Value, 9)
        Msei = Range("I37")
'贈り主名併記を変数に代入
        Range("I39") = Cells(16 + Range("H39").Value, 9)
        If Range("I39") = "併記しない" Then
            Heiki = 1
        ElseIf Range("I39") = "２人併記" Then
            Heiki = 2
        ElseIf Range("I39") = "３人併記" Then
            Heiki = 3
        Else
            Heiki = 1
        End If
'文字フォントサイズを変数に代入
        Range("I41") = Cells(23 + Range("H41").Value, 6)
        If Range("I41") = "" Then
            FSia = 33
        Else
            FSia = Range("I41")
        End If
'贈り主名フォントサイズを変数に代入
        Range("I43") = Cells(29 + Range("H43").Value, 6)
        If Range("I43") = "" Then
            FSib = 33
        Else
            FSib = Range("I43")
        End If
'贈り主名入れ表書きを変数に代入
        n = 0
        For k = 4 To 8
            If Cells(k, 5).Value = True Then
                OLNa(n) = Cells(k, 6).Value
                n = n + 1
            End If
        Next k
            Range("I27") = OLNa(0)
            Range("I28") = OLNa(1)
            Range("I29") = OLNa(2)
'贈り主名と併記指定差異判定
        If n <> Heiki Then
            MsgA = MsgBox("贈り主人数と併記人数が違います。" _
                & vbCrLf & "このまま確定で進めますか？", _
                vbYesNo + vbExclamation, "のし書き作成")
            If MsgA = 7 Then
                MsgBox "設定の確定を中止します。", _
                    vbExclamation, "のし書き作成"
                Range("I27") = ""
                Range("I28") = ""
                Range("I29") = ""
                Exit Sub
            End If
        End If
        ONa(1) = Range("I27")
        ONa(2) = Range("I28")
        ONa(3) = Range("I29")
End Sub

贈り主の名前の選択人数と併記する贈り主の数が一致しない場合は、チェックメッセージが表示され、そのまま進めるか、中止するかを問い合わせます。

パブリック変数を部品プロシージャーに落とし込む

noshigakitempkai003

贈り主名の縦位置設定

贈り主表書き縦位置の変数ONSを指定値に応じてセットします。（さらに部品プロシージャーを呼び出します。）

vbacalleyecatch 部品化プロシージャーでCallステートメントは必須
VBA
Sub 贈り主縦位置()
        Worksheets("設定").Select
'贈り主名印字スタイル　縦位置を変数に代入
        If ONS = "上詰め" Then
            Call Module1.上詰め
        ElseIf ONS = "中央揃え" Then
            Call Module1.中央揃え
        ElseIf ONS = "下詰め" Then
            Call Module1.下詰め
        ElseIf ONS = "両端揃え" Then
            Call Module1.両端揃え
        ElseIf ONS = "均等割り付け" Then
            Call Module1.均等割り付け
        End If
End Sub

贈り主名の文字制御設定

贈り主表書き文字の制御の変数Mseiを指定値に応じてセットします。

VBA
Sub 贈り主文字の制御()
        Worksheets("設定").Select
'贈り主名文字の制御を変数に代入
        If Msei = "折り返して全体を表示" Then
            Call Module1.折り返し全体
        ElseIf Msei = "縮小して全体を表示" Then
            Call Module1.縮小し全体
        ElseIf Msei = "" Then
            Call Module1.制御の設定なし
        End If
End Sub

結び切の修正設定

使用するのしの様式（結び切り）の変数RaPを指定値に応じてセットします。

VBA
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

贈り主名の併記の設定

贈り主併記の制御の変数Heiki、贈り先主名の配列ONa()、贈り主名のフォントサイズの変数FSib、結び切りの変数RaPを指定値に応じてセットします。（Ra、Ca、Rb、Cbは用紙サイズ別に後々に設定します。）

vbacellssyoshikieyecatch 「表示形式」をVBAコード的に最速理解する
VBA
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

贈り主名の文字設定

贈り主名文字の設定の部品プロシージャー

VBA
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

のし書きテンプレートベースのVBAコード

「のし書きBaseシート」が作成されているかどうかを調べて、無い場合は新規作成し余白設定などの印刷設定を行います。

sheetexistanceeyecatch シートの存在を確認する2種類のコードと実務での例題
VBA
'のし印刷テンプレートのベースづくり
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
        Call Module4.のし書きBaseシートクリア
        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

この「熨斗テンプレートベースB」プロシージャーが「のし書きBaseシート作成」時に実行されます。

「熨斗テンプレートベースA」はこの「熨斗テンプレートベースB」の部品プロシージャーとなります。

熨斗サイズの変数SVを指定値に応じてセットして、指定用紙のプロシージャーを呼び出します。

VBA
Sub 熨斗テンプレベースB()
        If MsgA = 7 Then
            MsgB = MsgBox("贈り主名が未確定です。" & vbCrLf & _
                "続けますか？", vbYesNo + vbQuestion, _
                "のし書き作成")
            If MsgB = 7 Then
                MsgBox "印刷をを中止します。", vbExclamation, _
                    "のし書き作成"
                Exit Sub
            End If
        End If
        Call Module1.熨斗テンプレベースA
        With Worksheets("のし書きBase")
             .Range("A1:BK16").VerticalAlignment = xlCenter
             .Cells.ClearContents
'項目で選択されたフォントの種類をセットします
            .Cells.Font.Name = "" & FNa & ""
        End With
        Call Module1.結び切り修正
        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
目次へ戻る

まとめ

noshigakitempkai002

「設定」シートで選択・決定したデータを、それぞれののし紙サイズで使用できるように整理整頓しました。

印刷設定の各項目は、部品化したプロシージャーで決定データをVBAコード化していきます。

その部品化プロシージャーを呼び出し実行すれば、印刷設定がされていくということです。

この後は、それぞれののし紙用紙サイズについてプロシージャーを組み、実行すれば印刷できるという仕組みになります。次回の説明になります。

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

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

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

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

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

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

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

目次へ戻る

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

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

NTTコム サーチ

af_banner01

Dstyle web

dstyleweb_logo
dstyle_320x50-min

前の記事

noshigakisyousai2eyecatch
ActiveXコントロールをシートに設置する。のし書き作成エク…

次の記事

作成したのし書きの印刷と別シートに保管するVBA
noshihozoneyecatch