チェックボックス（フォームコントロール）を任意のセルに配置する関数

先日来、フォームコントロールのチェックボックスを、アレコレすることに
挑戦している。
infoment.hatenablog.com

その過程で、任意の位置にチェックボックスを幾つか配置しているのだが、
これが面倒くさくなってきた。

そこで今回は、チェックボックスを任意のセルに配置することに挑戦する。

まず単純に、セルを引数に、チェックボックスを戻り値とする関数を作ってみた。

Function SetCheckBox(target_range As Range) As CheckBox
    Dim CB As CheckBox
        With target_range
            Set CB = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
        End With
    Set SetCheckBox = CB
End Function

テストしてみよう。

Sub test()
    SetCheckBox Selection
End Sub

でも、これだけだと面白くない。チェックボックスの名前と、
キャプション（チェックボックス横の文字列）も指定してみよう。

Function SetCheckBox(target_range As Range, _
            Optional cb_name As String = vbNullString, _
            Optional cb_caption As String = vbNullString) As CheckBox
    Dim CB As CheckBox
    
        ' チェックボックス配置。
        With target_range
            Set CB = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
        End With
        
        ' 名前とキャプションの指定があれば、それに変更する。
        If cb_name <> vbNullString Then CB.Name = cb_name
        If cb_caption <> vbNullString Then CB.Caption = cb_caption
        
    Set SetCheckBox = CB
End Function

テスト結果は、以下のとおり。

Sub test()
    SetCheckBox Selection
    SetCheckBox Selection.Offset(1), "CB", "指定した名前"
End Sub

ところで上記の例では、キャプションがチェックボックスの幅から
はみ出てしまっている。

気にしなければ、それまで。でも、ちょっと気になったので、調整してみる。
敢えてActiveXコントロールで作成し、AutoSizeで高さと幅を取得して、これを
フォームコントロール側に返してみた。

Function SetCheckBox(target_range As Range, _
            Optional cb_name As String = vbNullString, _
            Optional cb_caption As String = vbNullString) As CheckBox
    Dim CB As CheckBox
        ' チェックボックス配置。
        With target_range
            Set CB = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
        End With
        
        ' 名前とキャプションの指定があれば、それに変更する。
        If cb_name <> vbNullString Then CB.Name = cb_name
        If cb_caption <> vbNullString Then
            CB.Caption = cb_caption
            
            ' サイズ獲得用にActiveXコントロール配置。
            Dim CBX As OLEObject
            ' サイズさえ取れれば良いので、配置位置は不問。
            Set CBX = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1")
            ' 途中で折り返したままサイズ調整されないよう、充分な長さに引き伸ばしておく。
                CBX.Width = 1000
            ' 指定キャプションをセットして、サイズを自動調整。
                CBX.Object.Caption = cb_caption
                CBX.Object.AutoSize = True
            
            ' フォームコントロールのチェックボックスにサイズ反映。
                CB.Width = CBX.Width
                CB.Height = CBX.Height
                
            ' 不要になったActiveXコントロールを削除。
                CBX.Delete
        End If
        
    Set SetCheckBox = CB
End Function

幅の自動調整を盛り込むか否かは、各位のお好みで。
明日に続きます。

参考まで。