複数のチェックボックスで、一つだけチェックを入れたい ①

以前、下記内容でブログを書いた。
infoment.hatenablog.com

しかし実際に使う機会は、ほとんど来なかった。
まずチェックボックスには、以下の二通りがある。

フォームコントロール
ActiveX コントロール

f:id:Infoment:20191102185156p:plain

私がもっぱら使うのは、ActiveXコントロール。
だから、使う機会はほとんど無かった。
すると先日、こんなシートが私の下にやってきた。
f:id:Infoment:20191102192535p:plain

同時に二つ以上、選べないようにして欲しいとのこと。
※オプションボタンを使えば良いのでは？という意見は
承知してますとのコメント付きで。
f:id:Infoment:20191102192856p:plain

それでは試しに左側の４つに対し、一つだけチェック可能とする制御を
盛り込んでみよう。
f:id:Infoment:20191102193017p:plain

前回取り組んだ、シーソーのように「あちらが出れば、こちらが引っ込む」の
ような仕掛けは使えない。

Sub チェック10_Click()
    If ActiveSheet.CheckBoxes("Check Box 10").Value = xlOn Then
        ActiveSheet.CheckBoxes("Check Box 11").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 12").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 13").Value = xlOff
    End If
End Sub
Sub チェック11_Click()
    If ActiveSheet.CheckBoxes("Check Box 11").Value = xlOn Then
        ActiveSheet.CheckBoxes("Check Box 10").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 12").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 13").Value = xlOff
    End If
End Sub
Sub チェック12_Click()
    If ActiveSheet.CheckBoxes("Check Box 12").Value = xlOn Then
        ActiveSheet.CheckBoxes("Check Box 10").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 11").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 13").Value = xlOff
    End If
End Sub
Sub チェック13_Click()
    If ActiveSheet.CheckBoxes("Check Box 13").Value = xlOn Then
        ActiveSheet.CheckBoxes("Check Box 10").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 11").Value = xlOff
        ActiveSheet.CheckBoxes("Check Box 12").Value = xlOff
    End If
End Sub

f:id:Infoment:20191102193254g:plain

出来た。後はこれを、全１２個に拡張するだけだ・・・いやいや待て待て、そんなこと、やってられるか！

ということでしばらく試行錯誤して、以下の方法を試すことにした。

各チェックボックスに、クリックしたら実行するマクロを登録。
クリックされたチェックボックス以外は、チェックを外させる。

まず、登録がこちら。

Sub 登録()
    Dim CB As CheckBox
        For Each CB In ActiveSheet.CheckBoxes
            CB.OnAction = "切り替え"
        Next
End Sub

これで各チェックボックスはクリックされた時、「切り替え」サブルーチンを実行する。次いで、「切り替え」サブルーチンを作成。

Sub 切り替え()
    Dim CB As CheckBox
        For Each CB In ActiveSheet.CheckBoxes
            If CB.Caption <> Application.Caller Then
                CB.Value = xlOff
            End If
        Next
End Sub