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

nishigakisyousaieyecatch

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

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

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

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

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

noshigakisetteip004

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

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

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

などが考えられます。

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

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

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

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

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

noshigakisettei001a

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

noshigakisetteip005

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) = "MS Pゴシック"
            .Cells(12, 9) = "折り返して全体を表示"
            .Cells(13, 3) = "寿"
            .Cells(13, 6) = "MS 明朝"
            .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) = "2人併記"
            .Cells(19, 3) = "御開店御祝"
            .Cells(19, 9) = "3人併記"
            .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条件文は条件満足外でスルーされ、次のコード文へと進む。
  • ”名前”がなければ、判定ループの次の条件文で、その”名前”シートが新規作成される。
sheetexistanceeyecatch シートの存在を確認する2種類のコードと実務での例題 vbadoloopeyecatch VBA 回数不定のループ処理はDo LoopとFor Each vbaaddeyecatch 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
ポイント
  1. それぞれ2つずつのセルを連結
  2. セルの色を設定
  3. 値の表示を太字に設定
  4. 文字の色を設定
vbawithstateeyecatch With~End Withの使い方。VBAコードを簡潔に記述する vbacellsfonteyecatch 「フォント」の操作を最速理解する エクセルVBA vbacellspaintbackeyecatch 「塗りつぶし」背景色を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」で指定します。

ポイント
  1. 「Borders」を使えば4方向すべてに罫線を引くことが出来ます。
  2. 「BorderAround」を使えばセル範囲の外周部分に罫線を引くことが出来ます。
vbacellsbordereyecatch 「罫線」のVBAを最速理解 vbaborder1eyecatch 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

「設定」シートをVBAで作成のまとめ

noshigakisetteip006

このような設定シートを作成するやり方ではなくて、

テンプレートシート上に直接、作成内容を書き込みをするのがメジャーな方法かもしれません。

けれども、

作表方法をVBAコード化することで、万が一シートの内容を壊してしまったりしても、すぐにリカバリーすることが出来ます。

この記事では、作表と項目入力をコード化しました。

「設定」シートとしては、まだ完成ではありません。

次の記事では、「設定」シートにVBAコードでコントロールを配置していきます。

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

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

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

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

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

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