のし書き作成のエクセルVBAコードを組み立てる。 詳細設定シート編

Option Explicit
Option Base 1

Sub 設定欄作成()

    Dim j As Long
    
'設定シートが存在するかどうか
    Dim Sh As Worksheet
    Dim Flg As Boolean
        Flg = False
        For Each Sh In 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
            
'セルA1
            With Range("A1")
                .RowHeight = 54
                .Font.Size = 33
                .Font.Bold = True
            End With
             
'設定項目の見出しセル
            With Range("B2:C2,E2:F2,H2:I2")
                .Merge
                .Interior.ColorIndex = 20
                .Font.Bold = True
                .Font.ColorIndex = 5
            End With
            
            With Range("B10:C10,E10:F10,H10:I10")
                .Merge
                .Interior.ColorIndex = 20
                .Font.Bold = True
                .Font.ColorIndex = 5
            End With
            
            With Range("B3:C3,E3:F3,H3:I3,B11:C11,E11:F11,H11:I11")
                .Interior.ColorIndex = 15
            End With
            
            With Range("H16:I16,E23:F23,E29:F29")
                .Interior.ColorIndex = 15
            End With
                      
            With Range("H15:I15,E21:F21,E22:F22,E28:F28")
                .Merge
                .Interior.ColorIndex = 20
                .Font.Bold = True
                .Font.ColorIndex = 5
            End With
            
'表の罫線
            With Range("B2:C8")
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
        
            With Range("E2:F8")
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
            
            With Range("H2:I8")
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
            
            With Range("B10:C43")
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
            
            With Range("E10:F19")
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
            
            With Range("H10:I13")
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
             
            With Range("H15:I19")
                .Borders.LineStyle = xlContinuous
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
             
            With Range("E21:F26")
                .Borders.LineStyle = xlContinuous
            End With
            
            With Range("E28:F32")
                .Borders.LineStyle = xlContinuous
            End With
            
            With Range("E21:F32")
                .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
            End With
            
'選択済み一覧の作表
            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
            Range("H28:I28").Interior.ColorIndex = 0
            
            Range("H28:I28").Borders(xlEdgeTop).LineStyle = xlLineStyleNone
            
            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
            
'文字色を白にセットする（文字が見えないようにする）
            With Range("E4:E8")
                .Font.ColorIndex = 2
            End With
            
'文字記入一括処理
    Dim Mykmk(43, 9) As String
    Dim s As Long, t As Long
        
        Mykmk(1, 1) = "【熨斗書き】詳細設定"
        Mykmk(2, 2) = "熨斗サイズ"
        Mykmk(23, 8) = "項目選択済み一覧"
        Mykmk(24, 8) = "熨斗サイズ"
        Mykmk(2, 5) = "贈り主名入れ表書き"
        Mykmk(26, 8) = "贈り主名入れ表書き"
        Mykmk(2, 8) = "贈り主名印字スタイル　縦位置"
        Mykmk(30, 8) = "贈り主名印字スタイル　縦位置"
        Mykmk(4, 3) = "A5サイズ"
        Mykmk(4, 9) = "上詰め"
        Mykmk(5, 3) = "A4サイズ"
        Mykmk(5, 9) = "中央揃え"
        Mykmk(6, 3) = "B5サイズ"
        Mykmk(6, 9) = "下詰め"
        Mykmk(7, 3) = "B4サイズ"
        Mykmk(7, 9) = "両端揃え"
        Mykmk(8, 3) = "熨斗封筒"
        Mykmk(8, 9) = "均等割り付け"
        Mykmk(10, 2) = "慶弔名表書き"
        Mykmk(32, 8) = "慶弔名表書き"
        Mykmk(10, 5) = "文字フォント種"
        Mykmk(34, 8) = "文字フォント種"
        Mykmk(10, 8) = "贈り主名文字の制御"
        Mykmk(36, 8) = "贈り主名文字の制御"
        Mykmk(12, 3) = "御祝"
        Mykmk(12, 6) = "ＭＳ　Ｐゴシック"
        Mykmk(12, 9) = "折り返して全体を表示"
        Mykmk(13, 3) = "寿"
        Mykmk(13, 6) = "ＭＳ　Ｐ明朝"
        Mykmk(13, 9) = "縮小して全来を表示"
        Mykmk(14, 3) = "内祝"
        Mykmk(14, 6) = "メイリオ"
        Mykmk(15, 3) = "御礼"
        Mykmk(15, 6) = "游ゴシック"
        Mykmk(15, 8) = "贈り主名併記"
        Mykmk(38, 8) = "贈り主名併記"
        Mykmk(16, 3) = "御結婚御祝"
        Mykmk(17, 3) = "新築御祝"
        Mykmk(17, 9) = "併記しない"
        Mykmk(18, 3) = "御出産御祝"
        Mykmk(18, 9) = "２人併記"
        Mykmk(19, 3) = "御開店御祝"
        Mykmk(19, 9) = "３人併記"
        Mykmk(20, 3) = "御卒業祝"
        Mykmk(21, 3) = "御進学祝"
        Mykmk(21, 5) = "文字フォントサイズ"
        Mykmk(40, 8) = "文字フォントサイズ慶弔名"
        Mykmk(22, 3) = "御昇進祝"
        Mykmk(22, 5) = "慶弔名"
        Mykmk(23, 3) = "金賞"
        Mykmk(24, 3) = "銀賞"
        Mykmk(25, 3) = "佳作"
        Mykmk(26, 3) = "参加賞"
        Mykmk(27, 3) = "特別賞"
        Mykmk(28, 3) = "御中元"
        Mykmk(28, 5) = "贈り主名"
        Mykmk(42, 8) = "文字フォントサイズ贈り主名"
        Mykmk(29, 3) = "御歳暮"
        Mykmk(30, 3) = "御見舞"
        Mykmk(31, 3) = "御霊前"
        Mykmk(32, 3) = "御供"
        Mykmk(33, 3) = "志"
        Mykmk(34, 3) = "粗供養"
        Mykmk(35, 3) = "満中陰志"
        
        For s = 1 To 43
            For t = 1 To 9
                Cells(s, t).Value = Mykmk(s, t)
            Next t
        Next s

            With Range("B3,E3,H3,B11,E11,H11,H16,E23,E29")
                .Value = "チェック"
                .Font.Bold = True
            End With
            
            With Range("C3,F3,I3,C11,F11,I11,I16,F23,F29")
                .Value = "選択項目"
                .Font.Bold = True
            End With
            
        End With
    Range("A1").Select
    
End Sub