VBAで、選択範囲にチェックボックスを入れようとしたが、すべて選択範囲の左上に重ねて入ってしまう

Question

前提・実現したいこと

Microsoft360のエクセルを使っています。
VBAで指定した範囲のセルにチェックボックスを埋め込みたいです。

VBAで、指定した範囲のセルにチェックボックスを埋め込みたい
でヒントをいただいたのでできると思って解決にしたのですが、やっぱりうまくいきませんでした。

下のコードでは、飛び飛びの選択範囲を指定して、ForEachでセルごとに処理するように書いたつもりですが、C5だけにたくさんのチェックボックスが埋め込まれてしまいます。

コードの中のSample_CheckBox1()は下記のページからコピペしたもので、曰く選択範囲にチェックボックスが入れられるとのことですが、
チェックボックス埋め込み
何度読んでも、どこで埋め込むセルを指定しているのかわかりません。ActiveSheetで選択範囲が指定されるんでしょうか？

発生している問題・エラーメッセージ

デバッグ中に、「中断モードでは入力できません」と出る
セルの個数分はC5に埋め込まれているようです。

該当のソースコード

Private Sub CommandButton2_Click()

Dim checkBoxCells As Range
Dim checkBoxCell As Range

'指定した範囲にチェックボックス生成
Set checkBoxCells = Range("C5:C15,E5:E15,G5:G15,I5:I15")
checkBoxCells.Select

 For Each checkBoxCell In checkBoxCells
   Sample_CheckBox1
 Next

End Sub

Sub Sample_CheckBox1()
'チェックボックスのみとしてセルの中央に配置する
 
   Application.ScreenUpdating = False
     
    With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
         Link:=False, DisplayAsIcon:=False)
         'サイズを縮小しチェックボックスのみ表示
         .Height = 10
         .Width = 11
         '対象セルの中央配置
         .Top = .Top + (ActiveCell.Height - .Height) / 2
         .Left = .Left + (ActiveCell.Width - .Width) / 2
       With .Object
          'テキスト
          .Caption = ""
          '背景色
          .BackColor = rgbWhite  '色定数：白
          'チェックボックスON=True,OFF=False
          .Value = True
       End With
    End With
     
    Application.ScreenUpdating = True
     
End Sub

試したこと

中断モードでは入力できません　とか

が似た症状を扱っているように感じましたが、よくわかりませんでした。
シートを変えているのにOLEObjectを使うとまずいと言っているようなのであまり関係ないでしょうか？

Answer 1

Private Sub CommandButton2_Click()
    Dim chkBoxCells As Range
    Dim c As Range

    '指定した範囲にチェックボックス生成
    Set chkBoxCells = Me.Range("C5:C15,E5:E15,G5:G15,I5:I15")
    chkBoxCells.Select

    For Each c In chkBoxCells
        c.Activate
    Next
End Sub

まずは上記のコードをステップインで実行して、
画面上どう変わるのか確認してください。
基本的にアクティブセルは1つしか存在しません。
どれがアクティブセルか確認できるはずです。

子プロシージャには、はっきりどのセルに対して作業をするのか、
受け渡した方がよいかと思います。

アクティブになっているであろうセルを指定するのは、
他人任せな感じで個人的に嫌いです。
あと、マクロ実行中に間違ってセルをクリックしたら（そんなことが起きたりするのか不明ですが）、
意図しない挙動をする可能性がある気がして怖いです。

動作を確認したら、以下で試してみてください。

Private Sub CommandButton2_Click()
   'Application.ScreenUpdating = False

    Dim c As Range
    For Each c In Me.Range("C5:C15,E5:E15,G5:G15,I5:I15").Cells
        Sample_CheckBox1 c
    Next

    'Application.ScreenUpdating = True
End Sub

Private Sub Sample_CheckBox1(ByRef rngTarget As Range)
'チェックボックスのみとしてセルの中央に配置する
    With Me.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
         Link:=False, DisplayAsIcon:=False)
         'サイズを縮小しチェックボックスのみ表示
         .Height = 10
         .Width = 11
         '対象セルの中央配置
         .Top = .Top + (rngTarget.Height - .Height) / 2
         .Left = .Left + (rngTarget.Width - .Width) / 2
       With .Object
          'テキスト
          .Caption = ""
          '背景色
          .BackColor = rgbWhite  '色定数：白
          'チェックボックスON=True,OFF=False
          .Value = True
       End With
    End With
End Sub

Comments

[halmichi]

ありがとうございます。
デバッグがOLEオブジェクトがあるせいでできないなら、それを取り払って確認するのは思いつきませんでした。
Meの使い方も確かにご指摘の通りで、こちらのほうが確実です。
勉強になりました。

Answer 2

.Top = .Top + (ActiveCell.Height - .Height) / 2
.Left = .Left + (ActiveCell.Width - .Width) / 2

ActiveCellが指定されています。
この部分をご希望のセルに変えましょう。

---

これで

.Top = checkBoxCell.Top + (checkBoxCell.Height - .Height) / 2
.Left = checkBoxCell.Left + (checkBoxCell.Width - .Width) / 2

Comments

[halmichi]

```VBA
For Each checkBoxCell In checkBoxCells
Sample_CheckBox1 checkBoxCell
Next

End Sub

Sub Sample_CheckBox1(ByVal checkBoxCell As Range)
'チェックボックスのみとしてセルの中央に配置する

Application.ScreenUpdating = False

With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Link:=False, DisplayAsIcon:=False)
'サイズを縮小しチェックボックスのみ表示
.Height = 10
.Width = 11
'対象セルの中央配置
.Top = .Top + (checkBoxCell .Height - .Height) / 2
.Left = .Left + (checkBoxCell .Width - .Width) / 2
```
ありがとうございます。
上記のように直してみたのですが、やっぱり同じ症状です。
どこかおかしいでしょうか？
よろしくお願いいたします。

[radames1000]

追記したものをお試しくださいー

[halmichi]

なるほど、コピペ元の記事に複数チェックボックスが入っていたので、複数選択したセルに一発で入るものと思い込んでいましたが、そうではなかったんですね。
確かに今回作ったものは、いくら対象セルを変えて処理を繰り返しても、選択範囲は変わっていないのでC5に入り続ける形になっていました。
ありがとうございます。