フォームコントロールをシートに設置 のし書き作成エクセル

フォームコントロールをエクセルシートにVBAで自動設置します。
設定シートの決められた場所に動的に設置できますので、設定項目修正にも簡単に対応できます。

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

のし書き作成エクセルを改訂しました。

ActiveXコントロールを手作業で配置していたところを変更し、フォームコントロールに変更しVBAコードによって配置するようにしました。手作業での配置は行いません。

ActiveXとフォームでは、VBAコードがかなり違いますのでコードの流用は出来ません。

フォームコントロールのオプションボタンをエクセルシートへの設置については、こちらの記事シリーズで確認いただけます。

vbaopbtnformmatoeyecatch オプションボタンをVBAコードのみでシート設置する

フォームコントロールのシート設置完成形

noshigakisetteikai004

設定シートのデータ入力状態の完成形はこちらの様になります。

noshigakisetteikai001

今回の改定で一番大きな部分は、「フォームコントロールをVBAで設置する」ことです。

項目として変更点を列記すると、以下の項目になります。

目次へ戻る

設定シートへのコントロール配置のVBA

noshigakisetteikai005

これからのVBAコードの多くは、Module5に記述しています。

先にModule5に記述するすべてのコードを示します。

このVBAはコピペ可能です。

vbacopipeeyecatch Webで見つけたマクロをコピペで使う VBAFunctioneyecatch Functionプロシージャーとユーザー定義関数 vbacalleyecatch 部品化プロシージャーでCallステートメントは必須 vbawithstateeyecatch With～End Withの使い方。VBAコードを簡潔に記述する vbafontsyseyecatcha Fontプロパティで文字装飾操作をする vbaopbtnformmatoeyecatch オプションボタンをVBAコードのみでシート設置する
VBA
Option Explicit
Dim ob As OptionButton
Dim STR As Range
Dim Alert(8) As Long

Function ws() As Worksheet
        Set ws = ThisWorkbook.Worksheets("設定")
End Function

Function CR() As Long
        CR = STR.CurrentRegion.Rows.Count
End Function

Sub CONTセット()
        Call Module5.熨斗サイズCONTセット
        Call Module5.慶弔名表書きCONTセット
        Call Module5.文字フォント種CONTセット
        Call Module5.文字フォントサイズCONTセット
        Call Module5.贈り主名CONTセット
        Call Module5.縦位置CONTセット
        Call Module5.文字の制御CONTセット
        Call Module5.併記CONTセット
        Call Module5.名入れ表書きCONTセット
End Sub

Sub 熨斗サイズオプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("B2")
        s = CR
        If s <= 3 Then
            Alert(0) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(4, 2), Cells(s, 2))
            ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
            With Selection
                .Characters.Text = "熨斗サイズ"
                .Name = "熨斗サイズ"
            End With
        End With
'フォーカスをセルA1に移す
        ws.Range("A1").Select
        n = 0
'セルにオプションボタンを設置
        For i = 4 To s
            With Cells(i, 2)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "熨斗サイズ" & n
                    .LinkedCell = Range("H25").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H25").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'図形選択を解除します
        Range("A1").Select
        With Range(Cells(4, 2), Cells(s, 2))
            For Each ob In ws.OptionButtons
                If ob.Name Like "熨斗サイズ*" Then
                    ob.Select Replace:=False
                End If
            Next
        End With
       Selection.ShapeRange.Group.Name = "熨斗サイズG"
       Range("B3") = "●"
    ws.Range("A1").Select
End Sub

Sub 熨斗サイズクリア()
        If Alert(0) = 1 Then
        Alert(0) = 0
        Exit Sub
        End If
        If Range("B3") = "●" Then
            With Range("B4:B8")
                ws.Shapes("熨斗サイズG").Select
                Selection.Delete
                ws.GroupBoxes("熨斗サイズ").Select
                Selection.Delete
            End With
            Range("D3").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 熨斗サイズCONTセット()
        Call Module5.熨斗サイズクリア
        Call Module5.熨斗サイズオプションボタン
End Sub

Sub 慶弔名表書きオプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("B10")
        s = CR + 9
        If s <= 11 Then
            Alert(1) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(12, 2), Cells(s, 2))
             ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
             With Selection
                 .Characters.Text = "慶弔名表書き"
                 .Name = "慶弔名表書き"
             End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにオプションボタンを設置
        For i = 12 To s
            With Cells(i, 2)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "慶弔名表書き" & n
                    .LinkedCell = Range("H33").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H33").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'グループを設定します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "慶弔名表書き*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "慶弔名表書きG"
        Range("B11") = "●"
        Range("A1").Select
End Sub

Sub 慶弔名表書きクリア()
        If Alert(1) = 1 Then
            Alert(1) = 0
            Exit Sub
        End If
        If Range("B11") = "●" Then
            With Range("B12:B43")
                ws.Shapes("慶弔名表書きG").Select
                Selection.Delete
                ws.GroupBoxes("慶弔名表書き").Select
                Selection.Delete
            End With
            Range("D11").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 慶弔名表書きCONTセット()
        Call Module5.慶弔名表書きクリア
        Call Module5.慶弔名表書きオプションボタン
End Sub

Sub 文字フォント種オプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("E10")
        s = CR + 9
        If s <= 11 Then
            Alert(2) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(12, 5), Cells(s, 5))
            ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
            With Selection
                .Characters.Text = "文字フォント種"
                .Name = "文字フォント種"
            End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにチェックボックスを設置
        For i = 12 To s
            With Cells(i, 5)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "文字フォント種" & n
                    .LinkedCell = Range("H35").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H35").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'図形選択を解除します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "文字フォント種*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "文字フォント種G"
        Range("E11") = "●"
        Range("A1").Select
End Sub

Sub 文字フォント種クリア()
        If Alert(2) = 1 Then
            Alert(2) = 0
            Exit Sub
        End If
        If Range("E11") = "●" Then
            With Range("E12:E19")
                ws.Shapes("文字フォント種G").Select
                Selection.Delete
                ws.GroupBoxes("文字フォント種").Select
                Selection.Delete
            End With
            Range("G11").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 文字フォント種CONTセット()
        Call Module5.文字フォント種クリア
        Call Module5.文字フォント種オプションボタン
End Sub

Sub 文字フォントサイズオプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("E21")
        s = CR + 20
        If s <= 23 Then
            Alert(3) = 1
            Exit Sub
        End If

'グループボックスを設置
        With Range(Cells(24, 5), Cells(s, 5))
            ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
            With Selection
                .Characters.Text = "文字フォントサイズ"
                .Name = "文字フォントサイズ"
            End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにチェックボックスを設置
        For i = 24 To s
            With Cells(i, 5)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "文字フォントサイズ" & n
                    .LinkedCell = Range("H41").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H41").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'図形選択を解除します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "文字フォントサイズ*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "文字フォントサイズG"
        Range("E23") = "●"
        Range("A1").Select
End Sub

Sub 文字フォントサイズクリア()
        If Alert(3) = 1 Then
            Alert(3) = 0
            Exit Sub
        End If
        If Range("E23") = "●" Then
            With Range("E24:E27")
                ws.Shapes("文字フォントサイズG").Select
                Selection.Delete
                ws.GroupBoxes("文字フォントサイズ").Select
                Selection.Delete
            End With
            Range("G23").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 文字フォントサイズCONTセット()
        Call Module5.文字フォントサイズクリア
        Call Module5.文字フォントサイズオプションボタン
End Sub

Sub 贈り主名オプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("E28")
        s = CR + 27
        If s <= 29 Then
            Alert(4) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(30, 5), Cells(s, 5))
            ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
            With Selection
                .Characters.Text = "贈り主名"
                .Name = "贈り主名"
            End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにチェックボックスを設置
        For i = 30 To s
            With Cells(i, 5)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "贈り主名" & n
                    .LinkedCell = Range("H43").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H43").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'図形選択を解除します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "贈り主名*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "贈り主名G"
        Range("E29") = "●"
        Range("A1").Select
End Sub

Sub 贈り主名クリア()
        If Alert(4) = 1 Then
            Alert(4) = 0
            Exit Sub
        End If
        If Range("E29") = "●" Then
            With Range("E30:E32")
                ws.Shapes("贈り主名G").Select
                Selection.Delete
                ws.GroupBoxes("贈り主名").Select
                Selection.Delete
            End With
            Range("G29").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 贈り主名CONTセット()
        Call Module5.贈り主名クリア
        Call Module5.贈り主名オプションボタン
End Sub

Sub 縦位置オプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("H2")
        s = CR + 1
        If s <= 3 Then
            Alert(5) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(4, 8), Cells(s, 8))
            ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
            With Selection
                .Characters.Text = "縦位置"
                .Name = "縦位置"
            End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにチェックボックスを設置
        For i = 4 To s
            With Cells(i, 8)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "縦位置" & n
                    .LinkedCell = Range("H31").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H31").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'図形選択を解除します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "縦位置*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "縦位置G"
        Range("H3") = "●"
        Range("A1").Select
End Sub

Sub 縦位置クリア()
        If Alert(5) = 1 Then
            Alert(5) = 0
            Exit Sub
        End If
        If Range("H3") = "●" Then
            With Range("H4:H8")
                ws.Shapes("縦位置G").Select
                Selection.Delete
                ws.GroupBoxes("縦位置").Select
                Selection.Delete
            End With
            Range("J3").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 縦位置CONTセット()
        Call Module5.縦位置クリア
        Call Module5.縦位置オプションボタン
End Sub

Sub 文字の制御オプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("H10")
        s = CR + 9
        If s <= 11 Then
            Alert(6) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(12, 8), Cells(s, 8))
            ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
            With Selection
                .Characters.Text = "文字の制御"
                .Name = "文字の制御"
            End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにチェックボックスを設置
        For i = 12 To s
            With Cells(i, 8)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "文字の制御" & n
                    .LinkedCell = Range("H37").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H37").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
 '図形選択を解除します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "文字の制御*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "文字の制御G"
        Range("H11") = "●"
        Range("A1").Select
End Sub

Sub 文字の制御クリア()
        If Alert(6) = 1 Then
            Alert(6) = 0
            Exit Sub
        End If
        If Range("H11") = "●" Then
            With Range("H12:H13")
                ws.Shapes("文字の制御G").Select
                Selection.Delete
                ws.GroupBoxes("文字の制御").Select
                Selection.Delete
            End With
            Range("J11").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 文字の制御CONTセット()
        Call Module5.文字の制御クリア
        Call Module5.文字の制御オプションボタン
End Sub

Sub 併記オプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("H15")
        s = CR + 14
        If s <= 16 Then
            Alert(7) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(17, 8), Cells(s, 8))
            ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
            With Selection
                .Characters.Text = "併記"
                .Name = "併記"
            End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにチェックボックスを設置
        For i = 17 To s
            With Cells(i, 8)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "併記" & n
                    .LinkedCell = Range("H39").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字色を白色に変更
        With Range("H39").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'図形選択を解除します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "併記*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "併記G"
        Range("H16") = "●"
        Range("A1").Select
End Sub

Sub 併記クリア()
        If Alert(7) = 1 Then
            Alert(7) = 0
            Exit Sub
        End If
        If Range("H16") = "●" Then
            With Range("H17:H19")
                ws.Shapes("併記G").Select
                Selection.Delete
                ws.GroupBoxes("併記").Select
                Selection.Delete
            End With
            Range("J16").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 併記CONTセット()
        Call Module5.併記クリア
        Call Module5.併記オプションボタン
End Sub

Sub 名入れ表書きチェックボックス()
    Dim i, n, s As Long
    Dim Cb As CheckBox
        ws.Activate
        Set STR = Range("E2")
        s = CR + 1
        If s <= 3 Then
            Alert(8) = 1
            Exit Sub
        End If
        n = 0
        For i = 4 To s
            With Cells(i, 5)
'各セルにチェックボックスを配置しセルのサイズを調整
                ws.CheckBoxes.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "名入れ表書き" & n
                    .LinkedCell = Cells(i, 5).Address
                    .Name = "名入れ表書き" & n
                End With
            End With
            n = n + 1
'リンクセルの文字色を白色に変更
            Cells(i, 5).Font.Color = RGB(255, 255, 255)
        Next i
'図形選択を解除します
        Range("A1").Select
        For Each Cb In ws.CheckBoxes
            If Cb.Name Like "名入れ表書き*" Then
                Cb.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "名入れ表書きG"
        Range("E3") = "●"
        Range("A1").Select
End Sub

Sub 名入れ表書きクリア()
        If Alert(8) = 1 Then
            Alert(8) = 0
            Exit Sub
        End If
        If Range("E3") = "●" Then
            ws.Activate
            With Range("E4:E8")
                ws.Shapes("名入れ表書きG").Select
                Selection.Delete
            End With
            Range("E3").Clear
        Else
            Exit Sub
        End If
End Sub

Sub 名入れ表書きCONTセット()
        Call Module5.名入れ表書きクリア
        Call Module5.名入れ表書きチェックボックス
End Sub

Sub コントロール構成()
    Dim i, BCount As Long
'前回使用で設置したチェックボックスとコマンドボタンを削除
        With ws
            BCount = .Buttons.Count
            For i = BCount To 1 Step -1
                If .Buttons(i).Name <> "設定シートクリアボタン" Then
                    .Buttons(i).Delete
                End If
                BCount = .Buttons.Count
            Next i
'B3セルにコマンドボタン設置
            With .Range("B3")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "のしサイズリセット"
                    .OnAction = "熨斗サイズCONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'B11セルにコマンドボタン設置
            With .Range("B11")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "慶弔名表書きリセット"
                    .OnAction = "慶弔名表書きCONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'E3セルにコマンドボタン設置
            With Range("E3")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "贈り主名入れ表書きリセット"
                    .OnAction = "名入れ表書きCONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'E11セルにコマンドボタン設置
            With Range("E11")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "文字フォント種リセット"
                    .OnAction = "文字フォント種CONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'E23セルにコマンドボタン設置
            With Range("E23")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "文字フォントサイズリセット"
                    .OnAction = "文字フォントサイズCONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'E29セルにコマンドボタン設置
            With Range("E29")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "贈り主名リセット"
                    .OnAction = "贈り主名CONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'H3セルにコマンドボタン設置
            With Range("H3")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "縦位置リセット"
                    .OnAction = "縦位置CONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'H11セルにコマンドボタン設置
            With Range("H11")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "文字の制御リセット"
                    .OnAction = "文字の制御CONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'H16セルにコマンドボタン設置
            With Range("H16")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "併記リセット"
                    .OnAction = "併記CONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With
'E35セルに設定確定ボタン設置
            With .Range("E35:F36")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "設定確定"
                    .OnAction = "設定決め"
                    With .Characters
                    .Text = "設定を確定する"
                        With .Font
                            .Size = 15
                            .Bold = True
                            .ColorIndex = 5
                        End With
                    End With
                End With
            End With
'E38セルにコマンドボタン設置
            With .Range("E38:F39")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "のし印刷"
                    .OnAction = "熨斗テンプレベースB"
                    With .Characters
                    .Text = "のしを印刷する"
                        With .Font
                            .Size = 15
                            .Bold = True
                            .ColorIndex = 5
                        End With
                    End With
                End With
            End With
'E42セルにコマンドボタン設置
            With .Range("E41:F42")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "のし保存"
                    .OnAction = "熨斗シート保存"
                    With .Characters
                    .Text = "のしを保存する"
                        With .Font
                            .Size = 15
                            .Bold = True
                            .ColorIndex = 5
                        End With
                    End With
                End With
            End With
        End With
End Sub

選択項目の数の分だけコントロールを自動配置

それぞれの設定項目へのオプションボタンのVBA設置は、同様なコードの繰り返しとなります。

代表して、「慶弔名表書き」の設置VBAについて説明を行います。

プロシージャー「慶弔名表書きオプションボタン」

vbadoloopeyecatch VBA 回数不定のループ処理はDo LoopとFor Each
VBA
Sub 慶弔名表書きオプションボタン()
    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("B10")
        s = CR + 9
        If s <= 11 Then
            Alert(1) = 1
            Exit Sub
        End If
'グループボックスを設置
        With Range(Cells(12, 2), Cells(s, 2))
             ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
             With Selection
                 .Characters.Text = "慶弔名表書き"
                 .Name = "慶弔名表書き"
             End With
        End With
'フォーカスをセルA1に移す
        Range("A1").Select
        n = 0
'セルにオプションボタンを設置
        For i = 12 To s
            With Cells(i, 2)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "慶弔名表書き" & n
                    .LinkedCell = Range("H33").Address
                End With
            End With
            n = n + 1
        Next i
'リンクセルの文字を変更
        With Range("H33").Font
            .Color = RGB(0, 0, 255)
            .Bold = True
        End With
'グループを設定します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "慶弔名表書き*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "慶弔名表書きG"
        Range("B11") = "●"
        Range("A1").Select
End Sub

変数当基本設定部分

    Dim n, i, s As Long
        ws.Activate
        Set STR = Range("B10")
        s = CR + 9
        If s <= 11 Then
            Alert(1) = 1
            Exit Sub
        End If

モジュールレベル変数宣言セクションで、「STR」「Alert」を宣言しています。

「STR」は設定項目のコントロール配置開始セル

「Alert」はコントロールを配置するセルがない場合に出す警報（「1」を排出）

「ws」へは「設定シート」を代入する、「CR」へは選択項目の行数を代入する。その都度ファンクションプロシージャーを呼び出す。

グループボックスを設置

'グループボックスを設置
        With Range(Cells(12, 2), Cells(s, 2))
             ws.GroupBoxes.Add(.Left, .Top, .Width, .Height).Select
             With Selection
                 .Characters.Text = "慶弔名表書き"
                 .Name = "慶弔名表書き"
             End With
        End With

はじめにグループボックスを設置します。

グループボックスの機能は、ボックス内のコントロールがグループ化されることです。オプションボタンの場合は、ボックス内で1つの選択肢を選ぶことが出来るようになります。

シート上で手動でオプションボタンを設置する場合は、作成手順として1.オプションボタン配置　2.グループボックスとなります。

VBA設置の場合は、グループボックスを先に配置しておく必要があります。オプションボタン設置後にグループボックスを配置した場合は、「リンクセル設定が解除される」などの不具合が発生します。

設置範囲をセル位置で指定できます。グループボックス名と表示タイトル名を指定します。

セルにオプションボタンを設置

        n = 0
'セルにオプションボタンを設置
        For i = 12 To s
            With Cells(i, 2)
                ws.OptionButtons.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .Name = "慶弔名表書き" & n
                    .LinkedCell = Range("H33").Address
                End With
            End With
            n = n + 1
        Next i

Addメソッドでオプションボタンを追加設置します。

設置位置　「Add(.Left, .Top, .Width, .Height)」で設置セルサイズ一杯の配置です。

選択項目の数の分だけボタンを配置します。

表示タイトル名は「空白」（隣のセルに項目表示があるため）、ボタン名は「選択項目カテゴリ名＋番号」とします。

リンクセル（戻り値表示セル）は「項目選択済み一覧」のセルH33にします。

グループを設定します

'グループを設定します
        Range("A1").Select
        For Each ob In ActiveSheet.OptionButtons
            If ob.Name Like "慶弔名表書き*" Then
                ob.Select Replace:=False
            End If
        Next
        Selection.ShapeRange.Group.Name = "慶弔名表書きG"
        Range("B11") = "●"
        Range("A1").Select

グループ化を設定します。

こちらのグループ化はグループボックスとは違って、「同じカテゴリで設置するグループ」です。カテゴリを更新するときにボタンを一つづつ選択して削除するのではなく、カテゴリをまとめて一度に削除できるようにします。

このグループを作成するには、複数のオプションボタンをまとめて選択する必要があります。

複数のオプションボタンを選択する方法は、

  • Array関数を使う
  • Intersectメソッドで、指定のセル範囲内にオプションボタンの設置位置が入っているかどうか

などの方法があります。

結論として

設置数不定のオプションボタンを設置した数だけ一つのグループとするには、

ボタン名を指定して適合したボタンを纏め選択するのが、” 明快で簡単なコード仕上げ ” になることが分かりました。

コツとしては「ワイルドカード」を条件に使用することです。

最後に「 Range(“B11”) = “●” 」と一行付けている理由は

既にそのカテゴリでオプションボタンが設置されていることを示す「マーク」としています。

項目カテゴリをリセットするコマンドボタン設置

それぞれの項目カテゴリで、選択項目に変更があった場合、「選択項目」の表示はもちろん、設置しているオプションも変更する必要が出てきます。（項目が増減した時など）

その時は、リセットボタンをクリックして修正処理を行います。

プロシージャー「コントロール構成」の中の「B11セルにコマンドボタン設置」で説明します。

「コントロール構成」プロシージャー内のコードです。

VBA
'B11セルにコマンドボタン設置
            With .Range("B11")
                With ws.Buttons.Add(.Left, .Top, _
                            .Width, .Height)
                    .Name = "慶弔名表書きリセット"
                    .OnAction = "慶弔名表書きCONTセット"
                    With .Characters
                    .Text = "リセット"
                        With .Font
                            .Size = 11
                            .Bold = True
                            .ColorIndex = 3
                        End With
                    End With
                End With
            End With

コマンドボタンの設置については一か所で指定位置です。

こちらもAddメソッドで設置を行います。

表示タイトル名「リセット」はボタン表面に表示されます。

文字の表示設定をFontで指定することが出来ます。

ボタンクリック時のアクションは「OnAction」でプロシージャー名を指定します。

「慶弔名表書きCONTセット」プロシージャー

VBA
Sub 慶弔名表書きCONTセット()
        Call Module5.慶弔名表書きクリア
        Call Module5.慶弔名表書きオプションボタン
End Sub

2つの部品プロシージャーを持っています。

「慶弔名表書きクリア」プロシージャー

VBA
Sub 慶弔名表書きクリア()
        If Alert(1) = 1 Then 
            Alert(1) = 0
            Exit Sub
        End If
        If Range("B11") = "●" Then
            With Range("B12:B43")
                ws.Shapes("慶弔名表書きG").Select
                Selection.Delete
                ws.GroupBoxes("慶弔名表書き").Select
                Selection.Delete
            End With
            Range("D11").Clear
        Else
            Exit Sub
        End If
End Sub

この「慶弔名表書きクリア」プロシージャーは、

「慶弔名表書きオプションボタン設置グループ」と「慶弔名表書きグループボックス」を削除します。

ただし、これらのオブジェクト（オプションボタングループ）がなかった場合にプロシージャーが実行されるとエラーが発生します。

なので、

「Alert=1」になっているか、「”●”」になっているかをチェックしてエラーストップを防止しています。

「慶弔名表書きオプションボタン」プロシージャー

オプションボタンを一旦削除してから、先ほど説明したプロシージャーを実行します。

設定シートをクリアするボタンを設置

「シート初期化ボタン」は作成された「設定シート」に設置されます。ボタンをクリックすると「設定シート」が白紙に戻ります。

実行時はこのようになります。

noshigakisetteikai002

Module2の「設定欄作成」プロシージャーの最後に、「シート初期化ボタン」の設置VBAを記述しています。

'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

表示タイトル名「シート初期化ボタン」はボタン表面に表示されます。

文字の表示設定をFontで指定することが出来ます。

ボタンクリック時のアクションは「OnAction」でプロシージャー「設定シートクリア」を指定します。

このボタンに関連付けたプロシージャー「設定シートクリア」は、Module4に記述しています。

設定シートをデフォルトの真っ白状態に戻し、左上端に設定シート作成のための「【のし書き】詳細設定」ボタンを作成します。

VBA
Sub 設定シートクリア()
        With Worksheets("設定")
            .Cells.Clear
            .PageSetup.PrintArea = False
            .Cells.UseStandardHeight = True
            .Cells.UseStandardWidth = True
            .DrawingObjects.Delete
'セルA1
            With .Range("A1:C1")
                .Merge
                .RowHeight = 54
            End With
'A1セルにコマンドボタン設置
            With .Range("A1:C1")
                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
        End With
        Call Module4.のし書きBaseシートクリア
        MsgBox "のし書き作成の初期化が完了しました。", _
                        vbInformation, "のし書き作成"
End Sub

シートを白紙状態に戻す

        With Worksheets("設定")
            .Cells.Clear
            .PageSetup.PrintArea = False
            .Cells.UseStandardHeight = True
            .Cells.UseStandardWidth = True
            .DrawingObjects.Delete

このコードで、シート上にある設置したコントロール（オプションボタン、コマンドボタン）も全てクリアされます。

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

'セルA1
            With .Range("A1:C1")
                .Merge
                .RowHeight = 54
            End With
'A1セルにコマンドボタン設置
            With .Range("A1:C1")
                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
        End With
        Call Module4.のし書きBaseシートクリア
        MsgBox "のし書き作成の初期化が完了しました。", _
                        vbInformation, "のし書き作成"

設置するボタンサイズは、セルの大きさに合っているので、

デフォルトのセルサイズを変更してあらかじめ大きくしておきます。

このボタン設置で初期化完了になります。

最後に初期化完了のメッセージを表示します。

設定シートを作成するボタンを設置

設定シート作成「【のし書き】詳細設定」」ボタンは、初期化された「設定シート」に設置されます。

「【のし書き】詳細設定」」ボタンが実行されるとこのようになります。

noshigakisetteikai003

「【のし書き】詳細設定」のコマンドボタン設置のVBAコードは、先ほどの「設定シートクリア」プロシージャーに記述されています。

'A1セルにコマンドボタン設置
            With .Range("A1:C1")
                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

表示タイトル名「【のし書き】詳細設定」はボタン表面に表示されます。

文字の表示設定をFontで指定することが出来ます。

ボタンクリック時のアクションは「OnAction」でプロシージャー「設定シート作成セット」を指定します。

「設定シート作成セット」プロシージャー

VBA
Sub 設定シート作成セット()
        Call Module2.設定欄作成
        Call Module5.コントロール構成
        Call Module5.CONTセット
        MsgBox "設定シートの作成が完了しました。", _
                    vbInformation, "のし書き作成"
End Sub

3つのプロシージャーを順番に呼び出します。

「設定欄作成」プロシージャーは先の記事で説明しています。

nishigakisyousaieyecatch のし書き用の詳細設定シートをVBAコードで作成
  • 「コントロール構成」プロシージャー
  • 「CONTセット」プロシージャー

については、それぞれのオプションボタンの設置のVBAをひとまとめにしたプロシージャーになります。

（上述のModule5のVBAコードとして記述）

一例として「慶弔名表書きオプションボタン」の場合を説明しましたが、そのほかのカテゴリ項目のボタンの作成も含めた形でのプロシージャーになります。

目次へ戻る

フォームコントロールのVBA設置　まとめ

noshigakisetteikai006

のし書き作成エクセルの設定シートの作成が完了しました。

シート上で手作業でしていたコントロール設置を、VBAで行うことで作成作業、改定更新作業をより効率化できるようになりました。

コントロールのエクセルシートへのVBA設置方法は、いろいろ使い道もありますので、パターン化して覚えておくと便利かもしれません。

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

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

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

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

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

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

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

目次へ戻る

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

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

NTTコム サーチ

af_banner01

Dstyle web

dstyleweb_logo
dstyle_320x50-min

前の記事

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