のし書き用の詳細設定シートをVBAコードで作成

のし書き作成をエクセルVBAで組み立てます。詳細設定シートの作表を行います。
シートの作表をVBAコードで行うことで何度でも初期状態にリセットすることが出来ます。

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

今回から「のし書き作成エクセルソフト」をVBAコードで組み立てていきます。

この記事では、「設定」シートの作り方についてです。

のし書き作成エクセルの記事編成

のし書き作成エクセルの使い方とダウンロード
- 無料DLと取説のし書き作成エクセル既製のし紙を利用

のし書き作成エクセルの作成手順

コンテンツ

のし書き作成で詳細項目を設定するシート

のし書きを作成するには、結構、設定が必要な項目が多くあります。

入力セルやテキストボックスを指定してその都度、内容を入力指定してもらうか

チェックボックス、プルダウンメニューやオプションボタンで選択指定してもらうか

などが考えられます。

視認性と操作性の便利さでオプションボタンとチェックボックスを使用することにします。

この記事では、「設定欄」と「設定項目」を表示できるようにします。

直接シートに罫線などで作り込んでいってもいいのですが、ここはエクセルVBAコードを使っていきます。

この記事での詳細設定シートの作成部分

今回作る部分はこの部分です。

目次へ戻る

「設定」シート作成のためのVBAコード

9の代表項目の一覧表と数多くの選択肢欄があります。

それぞれの作表と選択肢項目の入力、セルのカラー設定とフォント設定など、結構細かいところが多いです。

このエクセルVBAコードはModule2に記述していきます。

エクセルVBAコードで作成すれば、コマンドボタンクリック一つで、いつでもデフォルト状態に戻すことが出来るようになります。

完成した全体のVBAコード

組み立てが完了したVBAコードはこのようになります。

VBA

Sub 設定欄作成()
    Dim j As Long
    Dim TgRM As Range
'設定シートが存在するかどうか
    Dim Sh As Worksheet
    Dim Flg As Boolean
        Flg = False
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.Name = "設定" Then
                Flg = True
                Exit For
            End If
        Next
'存在しなければ設定シートを新規作成
        If Flg = False Then
                Worksheets.Add before:=Worksheets(1)
                ActiveSheet.Name = "設定"
        End If
'設定シートに設定表を作表していく
        Worksheets("設定").Activate
        With Worksheets("設定")
'セルのスタイル
            .Rows("2:43").RowHeight = 27
            .Range("C:C, F:F, I:I").ColumnWidth = 22
            .Range("B:B,E:E,H:H").ColumnWidth = 8.88
'セルA1
            With .Shapes.Range(Array("設定シート作成")).Select
                With Selection
                    .Delete
                End With
            End With
            With .Range("A1:C1")
                .Merge
                .RowHeight = 54
                .Value = "【のし書き】詳細設定"
                With .Font
                    .Name = "メイリオ"
                    .Size = 21
                    .Bold = True
                    .ColorIndex = 5
                End With
            End With
'設定項目の見出しセル
            Set TgRM = Union(.Range("B2:C2,E2:F2,H2:I2"), _
                .Range("B10:C10,E10:F10,H10:I10"), .Range("H15:I15,E21:F21"))
            With TgRM
                .Merge
                .Interior.ColorIndex = 20
                With .Font
                    .Bold = True
                    .ColorIndex = 5
                    .Size = 13
                End With
            End With
            Set TgRM = Nothing
            With Range("E22:F22,E28:F28")
                .Merge
                .Interior.ColorIndex = 20
                With .Font
                    .Bold = True
                    .ColorIndex = 5
                    .Size = 13
                End With
            End With
            Set TgRM = .Range("C3, C11, F3, F11, F23, F29, I3, I11, I16")
            With TgRM
                .Value = "選択項目"
                .Interior.ColorIndex = 15
                    With .Font
                        .Bold = True
                        .Size = 13
                    End With
            End With
            Set TgRM = Nothing
'表の罫線
            Set TgRM = Union(.Range("B2:C8"), .Range("E2:F8"), _
                .Range("H2:I8"), .Range("B10:C43"), .Range("E10:F19"), _
                .Range("H10:I13"), .Range("H15:I19"), .Range("E21:F26"), _
                .Range("E28:F32"))
            With TgRM
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
            Set TgRM = Nothing
'選択済み一覧の作表
            With .Range("H23:I43")
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick, _
                    ColorIndex:=5
            End With
            For j = 24 To 42 Step 2
                .Range(Cells(j, 8), Cells(j, 9)).Select
                With Selection
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Interior.ColorIndex = 24
                End With
            Next j
            .Range("H23:I23").Interior.ColorIndex = 24
            With .Range("H28:I28")
                .Interior.ColorIndex = 0
                .Borders(xlEdgeTop).LineStyle = xlLineStyleNone
            End With
            With .Range("H23").Font
                .Size = 14
                .Bold = True
                .ColorIndex = 5
            End With
            With .Range("H24:H42").Font
                .Size = 13
                .Bold = True
            End With
'セル中の文字表示位置を指定します
            With .Range("F24:F26,F30:F32,I41:I43")
                .HorizontalAlignment = xlLeft
            End With
'文字記入一括処理
            .Cells(2, 2) = "熨斗サイズ"
            .Cells(23, 8) = "項目選択済み一覧"
            .Cells(24, 8) = "熨斗サイズ"
            .Cells(2, 5) = "贈り主名入れ表書き"
            .Cells(26, 8) = "贈り主名入れ表書き"
            .Cells(2, 8) = "贈り主名印字スタイル　縦位置"
            .Cells(30, 8) = "贈り主名印字スタイル　縦位置"
            .Cells(4, 3) = "A5サイズ"
            .Cells(4, 9) = "上詰め"
            .Cells(5, 3) = "A4サイズ"
            .Cells(5, 9) = "中央揃え"
            .Cells(6, 3) = "B5サイズ"
            .Cells(6, 9) = "下詰め"
            .Cells(7, 3) = "B4サイズ"
            .Cells(7, 9) = "両端揃え"
            .Cells(8, 3) = "熨斗封筒"
            .Cells(8, 9) = "均等割り付け"
            .Cells(10, 2) = "慶弔名表書き"
            .Cells(32, 8) = "慶弔名表書き"
            .Cells(10, 5) = "文字フォント種"
            .Cells(34, 8) = "文字フォント種"
            .Cells(10, 8) = "贈り主名文字の制御"
            .Cells(36, 8) = "贈り主名文字の制御"
            .Cells(12, 3) = "御祝"
            .Cells(12, 6) = "ＭＳ　Ｐゴシック"
            .Cells(12, 9) = "折り返して全体を表示"
            .Cells(13, 3) = "寿"
            .Cells(13, 6) = "ＭＳ 明朝"
            .Cells(13, 9) = "縮小して全体を表示"
            .Cells(14, 3) = "内祝"
            .Cells(14, 6) = "メイリオ"
            .Cells(15, 3) = "御礼"
            .Cells(15, 6) = "游ゴシック"
            .Cells(15, 8) = "贈り主名併記"
            .Cells(38, 8) = "贈り主名併記"
            .Cells(16, 3) = "御結婚御祝"
            .Cells(17, 3) = "新築御祝"
            .Cells(17, 9) = "併記しない"
            .Cells(18, 3) = "御出産御祝"
            .Cells(18, 9) = "２人併記"
            .Cells(19, 3) = "御開店御祝"
            .Cells(19, 9) = "３人併記"
            .Cells(20, 3) = "御卒業祝"
            .Cells(21, 3) = "御進学祝"
            .Cells(21, 5) = "文字フォントサイズ"
            .Cells(40, 8) = "文字フォントサイズ慶弔名"
            .Cells(22, 3) = "御昇進祝"
            .Cells(22, 5) = "慶弔名"
            .Cells(23, 3) = "金賞"
            .Cells(24, 3) = "銀賞"
            .Cells(25, 3) = "佳作"
            .Cells(26, 3) = "参加賞"
            .Cells(27, 3) = "特別賞"
            .Cells(28, 3) = "御中元"
            .Cells(28, 5) = "贈り主名"
            .Cells(42, 8) = "文字フォントサイズ贈り主名"
            .Cells(29, 3) = "御歳暮"
            .Cells(30, 3) = "御見舞"
            .Cells(31, 3) = "御霊前"
            .Cells(32, 3) = "御供"
            .Cells(33, 3) = "志"
            .Cells(34, 3) = "粗供養"
            .Cells(35, 3) = "満中陰志"
            .Cells(4, 6) = "(サンプル)田中"
            .Cells(5, 6) = "(サンプル)山田"
            .Cells(6, 6) = "(サンプル)岡山"
            .Cells(7, 6) = "(サンプル)谷岡"
            .Cells(24, 6) = 13
            .Cells(25, 6) = 15
            .Cells(26, 6) = 21
            .Cells(30, 6) = 15
            .Cells(31, 6) = 18
            .Cells(32, 6) = 25
'I1セルにコマンドボタン設置
            With .Range("H1:I1")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "設定シートクリアボタン"
                    .OnAction = "設定シートクリア"
                    With .Characters
                        .Text = "シート初期化ボタン"
                        With .Font
                            .Size = 15
                            .Bold = True
                            .ColorIndex = 3
                            .Name = "メイリオ"
                        End With
                    End With
                End With
            End With
            Range("A1").Select
        End With
End Sub

「設定」シート作成のVBAコード　ポイント説明

「設定」シートが既に存在しているか

作成したい設定シートが既に存在するかどうかをチェックします。

Sub 設定欄作成()
    Dim j As Long
    Dim TgRM As Range
'設定シートが存在するかどうか
    Dim Sh As Worksheet
    Dim Flg As Boolean
        Flg = False
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.Name = "設定" Then
                Flg = True
                Exit For
            End If
        Next
'存在しなければ設定シートを新規作成
        If Flg = False Then
                Worksheets.Add before:=Worksheets(1)
                ActiveSheet.Name = "設定"
        End If

シートの存在をチェックする方法（コード組み立て）はいろいろあるかと思いますが、

自分がいつも使っている方法はこのコードになります。

ポイント

真偽（TrueとFalse）を使って判定しますが、

シート”名前”があればTrueが返り、その時に判定のループを抜け出す。
次にあるIf条件文は条件満足外でスルーされ、次のコード文へと進む。
”名前”がなければ、判定ループの次の条件文で、その”名前”シートが新規作成される。

2022年7月9日シートの存在を確認する2種類のコードと実務での例題

2020年11月8日 VBA 回数不定のループ処理はDo LoopとFor Each

2022年11月20日 Excelシートを追加・挿入するAddメソッドの使い方

セルA1

セルA1については ” チョットした細工 “ があります。

「設定」シートの作成がVBAコードによって開始されたときに、「それまでにあったコマンドボタン」が削除されるように仕組んでいます。

「設定」シートが白紙の初期状態の時に「設定シート作成」ボタンだけ、A1からC1のセル上に配置されているようにしています。

そのボタンをクリックすることで、「設定」シートが作成される。という仕組みになっています。

作成が始まればこのボタンは不要（返ってジャマ）になりますので、ボタンを削除するためのVBAコードをここに埋め込んでいるというわけです。

'セルA1
            With .Shapes.Range(Array("設定シート作成")).Select
                With Selection
                    .Delete
                End With
            End With
            With .Range("A1:C1")
                .Merge
                .RowHeight = 54
                .Value = "【のし書き】詳細設定"
                With .Font
                    .Name = "メイリオ"
                    .Size = 21
                    .Bold = True
                    .ColorIndex = 5
                End With
            End With

設定項目の見出しセル

作表、見出しのセルの表示形式については、同じ仕様にしています。

1つ1つのセルを指定していては、 ” ダラダラ系 ” のコード表現になりがちですので、多数のRangeオブジェクトをUnionメソッドで一括で掴んで、一度に表示形式の設定を行っています。

'設定項目の見出しセル
            Set TgRM = Union(.Range("B2:C2,E2:F2,H2:I2"), _
                .Range("B10:C10,E10:F10,H10:I10"), .Range("H15:I15,E21:F21"))
            With TgRM
                .Merge
                .Interior.ColorIndex = 20
                With .Font
                    .Bold = True
                    .ColorIndex = 5
                    .Size = 13
                End With
            End With
            Set TgRM = Nothing

ポイント

それぞれ2つずつのセルを連結
セルの色を設定
値の表示を太字に設定
文字の色を設定

2020年12月4日 With～End Withの使い方。VBAコードを簡潔に記述する

2022年7月13日「フォント」の操作を最速理解するエクセルVBA

2022年7月16日「塗りつぶし」背景色をVBAで記述する

表の罫線

表に罫線を引く設定のコードです。

セルの上下左右それぞれに罫線のコード設定をしなくても、一度に引けてしまうコードです。

'表の罫線
            Set TgRM = Union(.Range("B2:C8"), .Range("E2:F8"), _
                .Range("H2:I8"), .Range("B10:C43"), .Range("E10:F19"), _
                .Range("H10:I13"), .Range("H15:I19"), .Range("E21:F26"), _
                .Range("E28:F32"))
            With TgRM
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
            Set TgRM = Nothing

罫線の幅や実線破線は、「LineStyle」で指定します。

ポイント

「Borders」を使えば4方向すべてに罫線を引くことが出来ます。
「BorderAround」を使えばセル範囲の外周部分に罫線を引くことが出来ます。

2022年7月16日「罫線」のVBAを最速理解

2022年5月22日 Bordersの/位置/線種/太さ/色/と<外枠だけの罫線>の設置

文字記入一括処理

それぞれの項目セルに文字をはめ込んでいきます。

ここは、セル値の羅列になります。

I1セルにコマンドボタン設置

最後に、シートの右上に「設定シートクリアボタン」を設置します。

このボタンのクリックによって、「設定」シートを白紙の初期状態に戻すことが出来るようになります。

OnActionでクリックで起動するプロシージャーを指定しています。（別記事にて説明）

'I1セルにコマンドボタン設置
            With .Range("H1:I1")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "設定シートクリアボタン"
                    .OnAction = "設定シートクリア"
                    With .Characters
                        .Text = "シート初期化ボタン"
                        With .Font
                            .Size = 15
                            .Bold = True
                            .ColorIndex = 3
                            .Name = "メイリオ"
                        End With
                    End With
                End With
            End With
            Range("A1").Select
        End With
End Sub