フォームコントロールをエクセルシートにVBAで自動設置します。
設定シートの決められた場所に動的に設置できますので、設定項目修正にも簡単に対応できます。
こんにちは、じゅんぱ店長(@junpa33)です。
のし書き作成エクセルを改訂しました。
ActiveXコントロールを手作業で配置していたところを変更し、フォームコントロールに変更しVBAコードによって配置するようにしました。手作業での配置は行いません。
ActiveXとフォームでは、VBAコードがかなり違いますのでコードの流用は出来ません。
フォームコントロールのオプションボタンをエクセルシートへの設置については、こちらの記事シリーズで確認いただけます。
オプションボタンをVBAコードのみでシート設置するのし書き作成エクセルの記事編成
- のし書き作成エクセルの使い方とダウンロード
- のし書き作成エクセルの作成手順
コンテンツ
フォームコントロールのシート設置完成形
設定シートのデータ入力状態の完成形はこちらの様になります。
今回の改定で一番大きな部分は、「フォームコントロールをVBAで設置する」ことです。
項目として変更点を列記すると、以下の項目になります。
- 選択項目の数の分だけコントロールを自動配置する。
- コントロールボタンを項目カテゴリごとにリセットするコマンドボタンを設置する。
- 設定シートを初期化(白紙)に戻す「設定シートクリアボタン」を設置する。
- 設定シートを白紙シートから作成する「設定シート作成ボタン」を設置する。
設定シートへのコントロール配置のVBA
これからのVBAコードの多くは、Module5に記述しています。
先にModule5に記述するすべてのコードを示します。
このVBAはコピペ可能です。
Webで見つけたマクロをコピペで使う Functionプロシージャーとユーザー定義関数 部品化プロシージャーでCallステートメントは必須 With~End Withの使い方。VBAコードを簡潔に記述する Fontプロパティで文字装飾操作をする オプションボタンを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について説明を行います。
VBA 回数不定のループ処理はDo LoopとFor Each
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セルにコマンドボタン設置」で説明します。
「コントロール構成」プロシージャー内のコードです。
'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」でプロシージャー名を指定します。
Sub 慶弔名表書きCONTセット()
Call Module5.慶弔名表書きクリア
Call Module5.慶弔名表書きオプションボタン
End Sub
2つの部品プロシージャーを持っています。
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」になっているか、「”●”」になっているかをチェックしてエラーストップを防止しています。
オプションボタンを一旦削除してから、先ほど説明したプロシージャーを実行します。
設定シートをクリアするボタンを設置
「シート初期化ボタン」は作成された「設定シート」に設置されます。ボタンをクリックすると「設定シート」が白紙に戻ります。
実行時はこのようになります。
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に記述しています。
設定シートをデフォルトの真っ白状態に戻し、左上端に設定シート作成のための「【のし書き】詳細設定」ボタンを作成します。
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
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, "のし書き作成"
設置するボタンサイズは、セルの大きさに合っているので、
デフォルトのセルサイズを変更してあらかじめ大きくしておきます。
このボタン設置で初期化完了になります。
最後に初期化完了のメッセージを表示します。
設定シートを作成するボタンを設置
設定シート作成「【のし書き】詳細設定」」ボタンは、初期化された「設定シート」に設置されます。
「【のし書き】詳細設定」」ボタンが実行されるとこのようになります。
「【のし書き】詳細設定」のコマンドボタン設置の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」でプロシージャー「設定シート作成セット」を指定します。
Sub 設定シート作成セット()
Call Module2.設定欄作成
Call Module5.コントロール構成
Call Module5.CONTセット
MsgBox "設定シートの作成が完了しました。", _
vbInformation, "のし書き作成"
End Sub
3つのプロシージャーを順番に呼び出します。
「設定欄作成」プロシージャーは先の記事で説明しています。
のし書き用の詳細設定シートをVBAコードで作成- 「コントロール構成」プロシージャー
- 「CONTセット」プロシージャー
については、それぞれのオプションボタンの設置のVBAをひとまとめにしたプロシージャーになります。
一例として「慶弔名表書きオプションボタン」の場合を説明しましたが、そのほかのカテゴリ項目のボタンの作成も含めた形でのプロシージャーになります。
フォームコントロールのVBA設置 まとめ
のし書き作成エクセルの設定シートの作成が完了しました。
シート上で手作業でしていたコントロール設置を、VBAで行うことで作成作業、改定更新作業をより効率化できるようになりました。
コントロールのエクセルシートへのVBA設置方法は、いろいろ使い道もありますので、パターン化して覚えておくと便利かもしれません。
エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。
エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です今回の記事はここまでです。 最後までご覧いただき有難うございました。
<記事内容についての告知>
VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。
アンケートでポイ活しよう!!
アンケートに答えれば答えるほど ”使える” ポイントがたまります。