クラスモジュールで関連付けたチェックボックスをCollectionオブジェクトに格納したい

Question

前提・実現したいこと

任意の数だけ自動生成されたOLEオブジェクトのチェックボックスを連動させるためにクラスモジュールを使いたい
の続きでまた詰まってしまいました。

1行目の日付とA列の名前の分だけチェックボックスを生成し、セルに入れます。
チェックボックスは1行2列が一単位なので、日付の後ろの列を増やしてチェックボックスを入れていきます。
左のチェックボックスがオンになると右のチェックボックスが入力可能になり、左が外れると右のチェックボックスはオフになったうえで入力不可にします。

これをクラスモジュールでチェックボックスの分だけ関連付けてCollectionオブジェクトに格納したいのですが、エラーになってしまいます。

チェックボックスをユーザーフォームに生成することも考えたのですが、パソコンをいじるのになれていない人も入力する予定で、表のほうがわかりやすいとの意見があったのでこの形で行きたいです。

よろしくお願いいたします。

追記分

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

修飾子が不正ですと出ます。
下から6行目のChkesが反転します。

該当のソースコード

Option Explicit

Public chBc As Long
Private Chkes() As New clsLinkedCheckBoxes'引数に1行上のchBcを入れた　1 To chBcにするとエラーが出るので消しました。定数式が必要ですと出ます。
Dim myChbes As Collection


Private Sub CommandButton1_Click()'日付入力 ここは問題ないです。
InputYearMonth: 'A1セルに年月を入力させる。日付の形でなければループさせる
Dim ym As String
Dim flg As Boolean

  flg = False
  Do
  
    ym = InputBox(Prompt:="年月を入力してください", Title:="年月入力")
    If Len(ym) = 0 Then Exit Sub
    If IsDate(ym) Then flg = True
  Loop Until flg = True
        
Cells(1, 1).Value = ym

InputDays:
Dim ds As String
Dim dates As Date
Dim i As Long

 For i = 1 To 4
    Do
   flg = False
   ds = InputBox(Prompt:=i & "日目の日付を入れてください", Title:="日付入力")
    If Len(ds) = 0 Then
      If i = 1 Then
       Exit Sub
      Else
       Exit For
      End If
    ElseIf Len(ds) <> 0 Then
    dates = DateAdd("d", ds - 1, Cells(1, 1).Value)
    End If
   If Month(dates) = Month(CDate(ym)) Then flg = True
   'Debug.Print Month(dates)
   'Debug.Print Month(CDate(ym))
   If flg = False Then MsgBox "月は変えられません", vbExclamation
  Loop Until flg = True
  
  Range(Cells(1, i + 1), Cells(2, i + 1)).Value = dates
  Cells(1, i + 1).NumberFormatLocal = "d"
  Cells(2, i + 1).NumberFormatLocal = "aaaa"
 Next i
 
Inputpts: '名を入力していく　キャンセルか入力なしで終わりか聞く
Dim pts As String
Dim Result As Long
Dim k As Integer
Dim flg2 As Boolean
Dim dc As Integer

 k = 5
 pts = 0
 flg2 = False

Do
 Do
  pts = InputBox(Prompt:="名を入れてください", Title:="名前入力")
   If Len(pts) <> 0 Then
   Cells(k, 1).Value = pts
   k = k + 1
   End If
 Loop Until Len(pts) = 0
 
   Result = MsgBox("入力を終了しますか？", vbYesNo + vbExclamation)
    If Result = vbYes Then
    flg2 = True
    End If
  
Loop Until flg2 = True

Dim apc As Integer
apc = k - 5
 If apc = 1 Then
  With Range("A4")
      .Interior.Color = RGB(255, 0, 0)
      .Font.Color = RGB(255, 255, 255)
      .Value = apc
  End With
 ElseIf apc > 9 Then
  With Range("A4")
      .Interior.Color = RGB(0, 255, 255)
      .Value = apc
  End With
 Else
  Range("A4").Value = apc
 End If
 
'パブリックのchBcにチェックボックスの数を格納
dc = Range("A1").End(xlToRight).Column - 2
chBc = apc * dc
 
crDdmChb: 'ドロップダウンメニューを生成
For i = 2 To 5
 With Cells(3, i).Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="泉,北"
 End With
 Cells(3, i).Interior.Color = RGB(255, 255, 204)
Next i
    
End Sub
Private Sub CommandButton2_Click()'後ろから列を挿入すればいいのに力技でレンジに格納する文字列を作ってしまっています。
Dim apc As Integer
Dim dc As Integer
Dim i As Integer
Dim j As Integer
Dim pc As Integer
Dim rg As String
Dim rgs As String
Dim edc As String
Dim edcs As String
Dim edcs2 As String
Dim cn As Variant
Dim chbr As String
Dim checkBoxCells As Range
Dim checkBoxCell As Range

'枠組み作製
dc = Range("A1").End(xlToRight).Column '最終入力列を取得
 For i = 2 To dc '数字に対応したアルファベットを作ってRange()に格納する範囲を作成
  rg = Chr(i + 65)
  edc = Chr((i * 2 - 1) + 64)
  rgs = rgs + rg + ":" + rg + ","
  edcs = edcs + edc + ":" + edc + ","
  edcs2 = edcs2 + edc + ","
  
 Next i
rgs = Left(rgs, Len(rgs) - 1)
edcs = Left(edcs, Len(edcs) - 1)
edcs2 = Left(edcs2, Len(edcs2) - 1)


Range("" + rgs + "").Insert '飛び飛び列挿入
Range("" + edcs + "").Validation.Delete
Range("" + edcs + "").ClearFormats

'指定した範囲にチェックボックス生成
pc = Range("A5").End(xlDown).Row
cn = Split(edcs2, ",") 'カンマで区切って文字列にする
Debug.Print VBA.TypeName(cn(0))
 For j = 0 To dc - 2
 chbr = chbr + cn(j) + "5" + ":" + cn(j) + CStr(pc) + ","
Next j

chbr = Left(chbr, Len(chbr) - 1)
Set checkBoxCells = Range("" + chbr + "")
checkBoxCells.Select

 For Each checkBoxCell In checkBoxCells
   Sample_CheckBox1 checkBoxCell
 Next
 
 Set checkBoxCells = Range("" + chbr + "").Offset(0, -1)
 
 For Each checkBoxCell In checkBoxCells
   Sample_CheckBox2 checkBoxCell
 Next
 
 Call clsLinked

End Sub

Sub Sample_CheckBox2(ByVal checkBoxCell As Range)
'チェックボックスのみとしてセルの中央に配置する
 
   Application.ScreenUpdating = False
     
    With Me.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
         Link:=False, DisplayAsIcon:=False)
          .Width = ActiveCell.Width - 5
          .Height = ActiveCell.Height - 5
         '対象セルの中央配置
         .Top = checkBoxCell.Top + (checkBoxCell.Height - .Height) / 2
         .Left = checkBoxCell.Left + (checkBoxCell.Width - .Width) / 2
       With .Object
          'テキスト
          .Caption = ""
          '背景色
          .BackColor = rgbWhite  '色定数：白
          'チェックボックスON=True,OFF=False
          .Value = False
       End With
    End With
    
    Application.ScreenUpdating = True
     
End Sub

Sub Sample_CheckBox1(ByVal checkBoxCell As Range)
'チェックボックスのみとしてセルの中央に配置する
 
   Application.ScreenUpdating = False
     
    With Me.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
         Link:=False, DisplayAsIcon:=False)
          '対象セルの枠内に収める
          .Width = checkBoxCell.Width - 5
          .Height = checkBoxCell.Height - 5
          .Top = checkBoxCell.Top + (checkBoxCell.Height - .Height) / 2
          .Left = checkBoxCell.Left + (checkBoxCell.Width - .Width) / 2
       With .Object
           'テキスト
           .Caption = "ﾘﾊ"
           '文字色
           .ForeColor = rgbBlack  '色定数：haiiro H00C0C0C0
           'フォントサイズ
           .Font.Size = 9
           '背景色
           .BackColor = rgbWhite '色定数：青色
           'チェックボックスON=True,OFF=False
           .Value = False
           .Enabled = False
       End With
    End With
     
    Application.ScreenUpdating = True
     
End Sub
Private Sub clsLinked()
    Dim i As Long
    
    Set myChbes = New Collection
    
    With Worksheets("Sheet1") 'チェックボックスのあるシート
        For i = 1 To chBc
            Chkes().SetCtrl .OLEObjects("CheckBox" & i + chBc).Object, _'先頭のChkesが修飾子が不正とのエラーが出ます。
                             .OLEObjects("CheckBox" & i).Object
    End With
        myChbes.Add Chkes()
        Next
End Sub

Private WithEvents Chk1 As MSForms.CheckBox
Private Chk2 As MSForms.CheckBox

Public Sub SetCtrl(newChk1 As MSForms.CheckBox, newChk2 As MSForms.CheckBox)
    Set Chk1 = newChk1
    Set Chk2 = newChk2
End Sub

Private Sub Chk1_Click()
  If Chk1.Value = False Then
    Chk2.Value = False
    Chk2.Enabled = False
  Else
    Chk2.Enabled = True
  End If
End Sub

試したこと

エクセルVBAでクラスのインスタンス生成時に初期データを格納するメソッドを作る方法
リンクの一連の記事でクラスモジュールとCollectionオブジェクトを勉強しました。

Option Explicit

Public chBc As Long
Private Chkes() As clsLinkedCheckBoxes'動的配列を宣言

'コマンドボタン1の中　A3にチェックボックスの数を格納
dc = Range("A1").End(xlToRight).Column - 2
chBc = apc * dc
Range("A3").Value = chBc

Private Sub clsLinked()
    Dim i As Long
    Dim Chkes As clsLinkedCheckBoxes 'ここでクラス変数を宣言、生成はしない

    
    chBc = Range("A3").Value
    With Me    'チェックボックスのあるシート
        For i = 1 To chBc
            Set Chkes = New clsLinkedCheckBoxes 'ここでクラスの実体を生成してクラス変数に格納
            Chkes.SetCtrl .OLEObjects("CheckBox" & i + chBc).Object, _
                        .OLEObjects("CheckBox" & i).Object
            
        Next
    End With
End Sub

Comments

[hatena19]

回答の前に確認ですが、CommandButton1、CommandButton2 はどこに配置してますか。
画像のシート（チェックボックスのあるシート）上ですか。
また、前のコード（クラスでない方）はこのシートのモジュールに記述してますか。

[halmichi]

ありがとうございます。

画像のシートに配置しています。Sheet1に記載できていると思います。
画像を追加しました。

よろしくお願いいたします。

[sinzo]

クラスのオブジェクト名がclsLinkedCheckBoxesで

Private Chkes As New clsLinkedCheckBoxes
と
With Worksheets("Sheet1")
For i = 1 To chBc
Chkes.SetCtrl .OLEObjects("CheckBox" & i + chBc).Object, _
.OLEObjects("CheckBox" & i).Object
myChbes.Add Chkes()
Next
End With
でエラーは消えるけど、、、？

[halmichi]

ありがとうございます。
エラーは出なくなりましたが、関連付けはできないようです。
デバッグ用にchBcを指定したまま進めると、Collectionオブジェクトに格納する行で
オブジェクトがプロパティかメソッドをサポートしていないというエラーが出てしまいます。

[sinzou]

PCちがうのでこちらから回答します。
私のWin10、office365、64bitでは
エラーなく終了しますが、動きませんね
hatena19さんのに書き換えても同じく（chBc=5)動きません
クラスについては勉強中ですが
Collectionに収めて、、、保持する必要は？です
EndSubの前のデバッグでは想定内なのですよね。

chBcはCommandButton1で計算されているのですね

[halmichi]

ありがとうございます。
こちらの環境も同じです。

＞chBcはCommandButton1で計算されているのですね
その通りです。

Answer 1

クラスについては勉強中なので

セル範囲の作成について

'枠組み作製
dc = Range("A1").End(xlToRight).Column '最終入力列を取得

For i = 2 To dc '作業列（Range()に格納する文字列）を作成
edcs = edcs & Columns((i - 2) * 2 + 3).Address(False, False) & ","
rgs = rgs & Columns(i + 1).Address(False, False) & ","
Next
rgs = Left(rgs, Len(rgs) - 1)
edcs = Left(edcs, Len(edcs) - 1)
Debug.Print rgs
Debug.Print edcs


pc = Range("A5").End(xlDown).Row
Set checkBoxCells = Intersect(Rows("5:" & pc), Range(edcs))
Debug.Print checkBoxCells.Address(False, False)

Stop

こんなこともできます、参考まで

Comments

[halmichi]

列のみを指定して相対参照を指定するとこの文字列が取り出せるんですね。
勉強になりました。

Answer 2

まず、冒頭のこの部分

Public chBc As Long
Private Chkes() As New clsLinkedCheckBoxes
Dim myChbes As Collection

Chkes() とすると動的配列になり、宣言時点では要素数0なので、 New clsLinkedCheckBoxes と生成(New)しても、ないもの対して生成はできない。
Private Chkes(44) As New clsLinkedCheckBoxes
というように定数を設定すれば定数分のクラスを生成(New)できる。
クラス数が固定ならこの方法がお手軽ではある。

Collection は自由に追加・削除できるので、クラス数が固定でない場合は、これに格納するとよい。
Collection に格納するなら、配列（Chkes() ）は不要。

そして、clsLinked()は下記のように修正してください。

Private Sub clsLinked()
    Dim i As Long
    Dim Chk As clsLinkedCheckBoxes 'ここでクラス変数を宣言、生成はしない

    Set myChbes = New Collection
    chBc = chBc 
    With Me    'チェックボックスのあるシート
        For i = 1 To chBc
            Set Chk = New clsLinkedCheckBoxes 'ここでクラスの実体を生成してクラス変数に格納
            Chk.SetCtrl .OLEObjects("CheckBox" & i + chBc).Object, _
                        .OLEObjects("CheckBox" & i).Object 
            myChbes.Add Chk '生成したクラスの実体をCollectionに追加
        Next
    End With
End Sub

追記

上記の修正だけではうまく動作しませんでした。
いろいろ試してみた結果、
チェックボックスの生成と、クラスの登録を別に実行するとうまくいくようです。

Private Sub CommandButton2_Click()
の最後の、
Call clsLinked
を削除して、
コマンドボタンをシート上に追加して(CommandButton3)、そのクリック時で、clsLinked を実行するとうまくいきました。

また、
Public chBc As Longのパブリック変数を参照する方法は不安定なので、clsLinked内で件数を取得する方法に変更しました。

Private Sub CommandButton3_Click()
    Call clsLinked
End Sub

Public Sub clsLinked()
    Dim i As Long
    Dim chk As clsLinkedCheckBoxes    'ここでクラス変数を宣言、生成はしない
    Dim ChkCount As Long
    
    Set myChbes = Nothing
    Set myChbes = New Collection
    
    ChkCount = (Range("A4").End(xlDown).Row - 4) * (Cells(1, Columns.Count).End(xlToLeft).Column \ 2)
    
    With ActiveSheet
        For i = 1 To ChkCount
            Set chk = New clsLinkedCheckBoxes    'ここでクラスの実体を生成してクラス変数に格納
            chk.SetCtrl .OLEObjects("CheckBox" & i + ChkCount).Object, _
                        .OLEObjects("CheckBox" & i).Object
            myChbes.Add chk
        Next
    End With
    
    MsgBox "終了"
End Sub

もし、1回ボタンをクリックするだけで、生成から、クラスの登録までしたい場合は、
Application.OnTime で clsLinked をタイマー実行するとうまくいきました。

OnTime は標準モジュールのプロシージャしか呼び出せないので、
clsLinkedプロシージャと Dim myChbes As Collection宣言を標準モジュールに移動させて、
CommandButton2_Click() の最後で、下記のように記述すればうまくいきます。

'前略

'    Call clsLinked これは削除
    Application.OnTime Now + TimeValue("00:00:01"), Procedure:="clsLinked"

End Sub

ユーザーフォームではこんな苦労することはないのですが、シート上のコントロールは扱いが難しいようです。

Comments

[halmichi]

ありがとうございます。
chBc = chBc は何をしているでしょうか？

というか、デバッグで見てみるとCommandButton1_Click()でchBcで格納した値がプロシージャを抜けると0になってしまっていました。仕方ないので、A3セルに格納してclsLinked()でまたそこを参照する形にしたのですが、やっぱり関連付けがされません。
デバッグでclsLinked()をたどらせると関連付けはされます。
clsLinked()が呼び出せてないんでしょうか？

よろしくお願いいたします。

[sinzou]

キャンセルします

[hatena19]

> chBc = chBc は何をしているでしょうか？

これはテスト用のコードを書き換えたときに間違たものです。削除してください。

chBc はシートのモジュールで宣言してますよね。
いちおう動作確認はしたのですが、テスト用コードを書き換える時にどこか間違たかもしれません。
今は、時間かないので、後でもう一度確認してみます。

[halmichi]

ありがとうございます。
よろしくお願いいたします。

[halmichi]

動的配列でのコードも思いついたので書いてみました。
が、やっぱり動きません。
というか、これだとデバックでたどらせてもうまくいかないようです。
何がおかしいでしょうか？
よろしくお願いいたします。

[hatena19]

ちょっとなかなか時間が取れてくてすみません。今日の夜あたりに時間取れそうなので確認してみます。

[hatena19]

うまくいく方法を見つけましたので、回答に追記しました。参照してください。

[halmichi]

ありがとうございます。うまくいきました。

標準モジュールも、意識したことがなかったので勉強になりました。

ブログ読ませていただきましたが、先頭に変数を宣言しているのは初心者向けにわかりやすい形にしてくださっているものと理解しました。直前に宣言するのは、確かに便利な考えだと思うのでこれから真似してみようと思います。

[hatena19]

うまくいきましたか。よかったです。
自分自身は、シート上にActiveXコントロールを置いてクラスに登録するということはほとんどしたことがなく、たいていユーザーフォーム上でやってますので、このような制限があるとは思わず引っかかりました。
今回の感想としては、シート上のActiveXコントロールはいろいろ扱いづらいので、ユーザーフォームで作成した方かいいとますます確信したということですね。たぶん、ユーザーフォームを使い慣れていないのだと思いますが、今回の要件もユーザーフォームの方が使いやすくものにできると思います。
今後のためにも頭の片隅にでも置いておいてください。

[halmichi]

ありがとうございます。
一応この方向で完成までもっていきますが、時間を作ってユーザーフォーム型も作ってみて試してみてもらおうと思います。