Private Sub UserForm_Initialize()
Set WeekBtn = New clsBpcaCmd ' インスタンスの生成
With WeekBtn
.Add cmdSun ' コントロールをクラス（親）内に登録していく
.Add cmdMon
.Add cmdTue
.Add cmdWed
.Add cmdThu
.Add cmdFri
.Add cmdSat
.Rgst
' クラス（親）に登録したコントロールでクラス配列（子）を作成させる
End With
End Sub
Private Sub UserForm_Terminate()
WeekBtn.Clear ' Clear メソッドは最後(Terminate
で)に必ず実行する事
Set WeekBtn = Nothing
End Sub
Private Sub WeekBtn_Click(ByVal Index As Integer)
Dim vntWeekName As Variant
Dim i As Integer
vntWeekName = Array("", "日", "月", "火",
"水", "木", "金", "土")
MsgBox vntWeekName(Index) & "曜日ボタンがクリックされました("
& Index & ")"
If (WeekBtn.Item(Index).BackColor = vbButtonFace)
Then
WeekBtn.Item(Index).BackColor = vbRed
For i = 1 To WeekBtn.Count ' クリックしたボタン以外を元の色に戻す
If (i <> Index) Then
WeekBtn.Item(i).BackColor
= vbButtonFace
End If
Next i
End If
End Sub
[ Export file : clsBpcaCmd.cls ]
'---( Item property )---------------------------------------------
Public Property Get Item(ByVal Index As Integer) As MSForms.CommandButton Attribute Item.VB_UserMemId = 0
If (blnRgst = True) And _
(Index > 0) And (Index <= colCtrl.Count) Then
'------[ 発生イベント定義(利用側へ上げる) ]--------------
Public EventClick (ByVal Index As Integer)
'------[ コントロール配列定義 ]--------------------------
Private clsCtrlCh() As clsBpcaCmdCh 'BpcaCmd 子クラス
Private colCtrl As Collection
'登録コントロール
Private blnRgst As Boolean 'Rgst 済(True)/未(False)
Private Sub Class_Initialize()
Set colCtrl = New Collection ' インスタンスの生成
End Sub
Private Sub Class_Terminate()
If (blnRgst = True) Or (Not (colCtrl Is Nothing))
Then
'呼び元(UserForm)での「後始末： Clear メソッド実行」忘れへの対策
Me.Clear
End If
End Sub
'---( Add メソッド )------------------------------------
'配列化するコントロールをコレクションに追加
Public Sub Add (ByVal NewCtrl As MSForms.CommandButton)
colCtrl.Add NewCtrl
End Sub
'---( Rgst メソッド)------------------------------------
'コレクションに載せたコントロールをクラス登録して配列化
Public Sub Rgst()
Dim i As Integer
If (blnRgst = True) Then
'実行済み
ElseIf (colCtrl.Count = 0) Then
blnRgst = False
Else
ReDim clsCtrlCh(1 To colCtrl.Count)
For i = 1 To colCtrl.Count
Set clsCtrlCh(i) = New clsBpcaCmdCh ' インスタンスの生成
With clsCtrlCh(i)
.Item =
colCtrl(i)
.Index =
i
.Parent
= Me
End With
Next i
blnRgst = True
End If
End Sub
'---( Clear メソッド Classの解放/初期化 )--------------------
Public Sub Clear()
Dim i As Integer
If (blnRgst = True) Then
For i = 1 To colCtrl.Count
clsCtrlCh(i).Clear
Next i
End If
Set colCtrl = Nothing
Erase clsCtrlCh
blnRgst = False
End Sub
'---( Count プロパティ)--------------------------------------
'登録されているコントロール数を返す
Public Property Get Count() As Integer
Count = colCtrl.Count
End Property
'---( Item プロパティ)---------------------------------------
'コントロール配列から、個々のコントロールオブジェクトを返す
Public Property Get Item(ByVal Index As Integer) As MSForms.CommandButton
If (blnRgst = True) And _
(Index > 0) And (Index <= colCtrl.Count)
Then
Set Item = colCtrl(Index)
Else
Set Item = Nothing
End If
End Property
'---( ItemCtrl プロパティ)---------------------------------------
' Item ( MsForms.CommandButton )ではオブジェクトのNameプロパティを取得できないので、
' Nameプロパティを取得可能なControlクラスで返す
Public Property Get ItemCtrl(ByVal Index As Integer) As MSForms.Control
If (blnRgst = True) And _
(Index > 0) And (Index <= colCtrl.Count)
Then
Set ItemCtrl = colCtrl(Index)
Else
Set ItemCtrl = Nothing
End If
End Property
'===========================================================
'===== clsBpcaCmdCh から呼ばれるイベント励起メソッド =========
'===========================================================
Public Sub RaiseClick(ByVal Index As Integer) RaiseEventClick(Index)
End Sub
'------[ イベントを取得する為のコントロール定義 ]-------------------
Private WithEvents MyCtrl As MSForms.CommandButton
Private MyIndex As Integer
'コントロール番号
Private MyParent As clsBpcaCmd '親クラスへの参照
Private blnParent As Boolean '[Parent]登録の有無
'---( Clear メソッド)----------------------------------------------
Public Sub Clear()
Set MyCtrl = Nothing
Set MyParent = Nothing
blnParent = False
MyIndex = 0
End Sub
'---( Item プロパティ)------------------------------------------------
Public Property Let Item(NewCtrl As MSForms.CommandButton)
Set MyCtrl = NewCtrl
End Property
'---( Index プロパティ)------------------------------------------------
Public Property Let Index(NewIndex As Integer)
MyIndex = NewIndex
End Property
'---( Parent プロパティ)------------------------------------------------
Public Property Let Parent(NewParent As clsBpcaCmd)
blnParent = True
Set MyParent = NewParent
End Property
'===================================================================
'===== 登録したコントロールのイベントを取得する ======================
'===================================================================
'コントロールのイベントを受けたら、そのまま、呼び元の親クラスへ、更にイベントを上げる
Private Sub MyCtrl_Click()
If (blnParent = True) Then
MyParent.RaiseClick MyIndex
End If
End Sub
残念ながら、それでは解決にはなりません。何故なら・・・ MsForms.TextBox 等からMsForms.Control へのコントロールオブジェクトのコピー
が出来ないのです。下記のコピーはエラーになります。
Dim Ctrl1 As MsForms.TextBox
Dim Ctrl2 As MsForms.Control
Set Ctrl2 = Ctrl1 'Error
'===============================================================
'===== イベント通知プロシジャー ==================================
'===============================================================
Private Sub Raise_Click(ByVal Index As Integer)
Call MyCaller.WeekBtn_Click(Index)
End Sub
Private Sub WeekBtn_Click(ByVal Index As Integer)
Dim vntWeekName As Variant
vntWeekName = Array("", "日", "月",
"火", "水", "木", "金", "土")
MsgBox vntWeekName(Index) & "曜日ボタンがクリックされました("
& Index & ")"
If (WeekBtn.Item(Index).BackColor = vbButtonFace)
Then
WeekBtn.Item(Index).BackColor = vbRed
Else
WeekBtn.Item(Index).BackColor = vbButtonFace
End If
End Sub
'===================================================================
'===== イベント通知受領プロシジャー(Public) ==========================
'===================================================================
'※ [clsBpca97]クラスでは、[clsBpca97]クラスに登録したコントロールの
' イベントは、全てのグループが、この
' 通知受領プロシジャー[clsBpca97__Event] <名称固定>
' を通して送られてくる。
' [GrpId]によって、所定のグループ別のイベントプロシジャーに分岐させる。
' (通知受領プロシジャーは、名前の重複を防ぐ為に敢えてアンダーバーを２つ繋げている)
Public Sub clsBpca97__Event _
(ByVal GrpId As String, _ByVal EventId
As Long, ByVal Index As Integer, _
ByVal Cancel As MSForms.ReturnBoolean,
_
ByVal KeyCode_Ascii As MSForms.ReturnInteger,
_
ByVal Button As Integer, ByVal
Shift As Integer, _
ByVal X As Single, ByVal Y As
Single)
Select Case GrpId
Case "WeekBtn"
Select Case EventId
Case BPCA_Click
Call WeekBtn_Click(Index)
Case Else
End Select
Case Else
End Select
End Sub
'===================================================================
'===== clsBpca97Ch から呼ばれるイベント励起メソッド ==================
'===================================================================
Public Sub RaiseClick(ByVal Index As Integer)
Call Raise_Event(BPCA_Click, Index, DmyCancel, DmyKeyCode_Ascii, 0, 0, 0, 0)
End Sub
Public Sub RaiseDblClick _
(ByVal Index As Integer, ByVal Cancel As MSForms.ReturnBoolean)
Call Raise_Event(BPCA_DblClick, Index, Cancel, DmyKeyCode_Ascii, 0, 0, 0, 0)
End Sub
：
：
'===================================================================
'===== イベント通知共通プロシジャー ==================================
'===================================================================
'※ [clsBpca97]クラスでは、呼び元のUserFormに用意してある
' 通知受領サブ[clsBpca97__Event] <名称固定>
' をCallする事でイベント発生を通知する
' (通知受領サブは、名前の重複を防ぐ為に敢えてアンダーバーを２つ繋げている)
Private Sub Raise_Event _
(ByVal EventId As Long, ByVal Index
As Integer, _
ByVal Cancel As MSForms.ReturnBoolean, _
ByVal KeyCode_Ascii As MSForms.ReturnInteger, _
ByVal Button As Integer, ByVal
Shift As Integer, _
ByVal X As Single, ByVal Y As
Single)
Private WithEvents MyCtrlCmd As MSForms.CommandButton
Private Sub MyCtrlCmd_Click()
If (blnParent And blnEventClick And MyEnableEvents)
Then
MyParent.RaiseClick MyIndex
End If
End Sub
Private Sub MyCtrlCmd_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If (blnParent And blnEventDblClick And MyEnableEvents)
Then
MyParent.RaiseDblClick MyIndex, Cancel
End If
End Sub
：
：
纏めると、
