この トグルラベル クラス (旧版) は 『 疑似からの脱却 』 手法へと発展していく基になったものです。
先ず、RaiseEvent を使わない クラスモジュールひとつの clsTglLabel が出来ました。 これが、2つのクラス
モジュールを親/子で使い、RaiseEvent を利用した [ clsTglLblGrp & clsTglLabelEx ] へと発展しました。
この [ clsTglLblGrp & clsTgllabelEx ] を整理して体系化したものが 『 疑似からの脱却 - clsBpca - 』です。
現状では既に必要の無くなったものですが、『疑似からの脱却』への軌跡として残しておきます。
( 2004/5/17 第 2 版 ) 最新の[ Ver4.0 ]は こちら
(利用方法)
1.このページでは、Excel97 でも利用できるようにした[clsTglLabel ]クラスのサンプルを解説します。
Excel97 ではカスタムイベントを発生させる[RaiseEvent ]が使えませんので、代替手法を駆使し
て、[RaiseEvent ]と同様の動きをさせています。
2.下記のサンプルブックをダウンロードして、
クラスモジュール[clsTglLabel ]
を各自のブックにインポートしてください。
クラスモジュールの内容は一部を除き、変更する必要はありません。
('変更を要する一部'については下記[9]項の解説を参照)
サンプルブック( ToggleLabel_V2.zip 118KB ) 2004/5/17 第 2 版
[ clsTglLblGrp ] [ clsTglLabelEx/clsTglLabel ] クラス リファレンス解説ページ
3.以降、サンプルブックの例をもとに解説します。
・先ず、UserFormにトグルラベル用のラベルコントロールを配置します(サンプルでは曜日
ボタンを例にしてます)。
・サンプルフォームでの、ボックスには、この[トグルラベル]クラスのクリックイベントを受けて、
クリックしたボタンと値が表示されます。
・『Value 』ボタンは、グループ全体のオン/オフ状態をMsgBoxに表示します。
・『Enabled 』ボタンは、グループ全体のEnabledプロパティを切り換えます。
・『All On/Off 』ボタンは、グループ全体を一度に[ON/OFF]に設定します。
4.UserFormのモジュール宣言セクションにて、[clsTglLabel ]クラスを参照する変数を定義します。
クラスオブジェクト変数は、ボタンの数だけの配列として定義します(先頭の添字は1からです。
この例では曜日ボタンなので、添字として[vbSunday(1)〜vbSaturday(7) を使っています)。
同時に、ボタンとして使うラベルオブジェクトを取りまとめるコレクション用オブジェクト変数も定
義します。
WithEvents が無いので [New]キーワードを付ける事ができます。
'【1】[排他]有りサンプル
Private colTglLbl_Week1 As New Collection
Private clsTglLbl_Week1(vbSunday To vbSaturday) As New clsTglLabel
'【2】[排他]無しサンプル
Private colTglLbl_Week2 As New Collection
Private clsTglLbl_Week2(vbSunday To vbSaturday) As New clsTglLabel
5.Initialize イベント内で、用意したラベルコントロールを[clsTglLabel ]クラスに登録しますが、
それに先立ち、登録処理のコードを簡素化する為に、使用するラベルオブジェクトをコレク
ション化します。これによって、全てのラベルが添字を使って参照できるようになり、コードを
ループ処理で簡素化できます。
クラスオブジェクト変数定義の際に[New]キーワードを付けているので、[New]キーワードを
付けたSet ステートメントは省略しても構いません)。
[clsTglLabel]クラスオブジェクトの変数(同一グループの個々のボタン全て)に対して、
Rgst メソッドで、
・ラベルコントロール(コレクションから添字指定)
・ボタン番号(同一グループ内での通番=コレクションに追加した順番)
・クラス内で同一グループを構成しているラベルを取得する為のコレクション
・他のグループと区別/識別する為のグループID
・排他指定([True ]を指定すると【排他あり】、[False ]を指定すると【排他なし】)
Caller プロパティに
・自UserForm の名前(Me.Name )
を指定して登録します。
Private Sub UserForm_Initialize()
Dim i As Integer
vntWeek = Array ("", "日", "月", "火", "水", "木", "金", "土")
'-------------------------------------------------------------
'【1】 [clsTglLabel_for97]を使った「排他」有りサンプル
'定義で[New]を付けているので、下記のSetステートメント
'については省略しても構わない
Set colTglLbl_Week1 = New Collection
With colTglLbl_Week1
.Add lblSun1
.Add lblMon1
.Add lblTue1
.Add lblWed1
.Add lblThu1
.Add lblFri1
.Add lblSat1
End With
For i = 1 To colTglLbl_Week1.Count
'定義で[New]を付けているので、下記のSetステートメント
'については省略しても構わない
Set clsTglLbl_Week1( i ) = New clsTglLabel
With clsTglLbl_Week1( i )
.Rgst colTglLbl_Week1( i ) , i , colTglLbl_Week1, "Week1", True 'Trueで[排他]あり
.Caller = Me.Name '呼び元のUserForm名
End With
Next i
'-------------------------------------------------------------
'【2】 [clsTglLabel_for97]を使った「排他」無しサンプル
'定義で[New]を付けているので、下記のSetステートメント
'については省略しても構わない
Set colTglLbl_Week2 = New Collection
With colTglLbl_Week2
.Add lblSun2
.Add lblMon2
.Add lblTue2
.Add lblWed2
.Add lblThu2
.Add lblFri2
.Add lblSat2
End With
For i = 1 To colTglLbl_Week2.Count
'定義で[New]を付けているので、下記のSetステートメント
'については省略しても構わない
Set clsTglLbl_Week2( i ) = New clsTglLabel
With clsTglLbl_Week2( i )
.Rgst colTglLbl_Week2( i ) , i , colTglLbl_Week2, "Week2", False 'Falseで[排他]なし
.Caller = Me.Name '呼び元のUserForm名
End With
Next i
End Sub
Private Sub UserForm_Terminate()
Dim i As Integer
Set colTglLbl_Week1 = Nothing
Set colTglLbl_Week2 = Nothing
For i = vbSunday To vbSaturday
Set clsTglLbl_Week1( i ) = Nothing
Set clsTglLbl_Week2( i ) = Nothing
Next i
End Sub
6.ボタンの状態(オン/オフ:凹凸)は、[Value]プロパティで取得します(True もしくは False
が返ります)。
同じグループ内の代表となるボタン(どれでも構いません)のクラスオブジェクトに対して、
[GrpValue]プロパティを使うことでも、ボタンの状態を取得できます。その際、引数にボタン
番号を指定するか否かで、2種類の使い方が出来ます。
・ボタン番号を指定
指定したボタン番号のオン/オフ状態が[True/False]で返ります(Value と同じ)。
この場合に取得できるのは、クラスオブジェクト側に指定したボタンの状態ではなく、
[GrpValue]プロパティ側に指定したボタン番号のボタンの状態になります。
・ボタン番号を省略/ゼロ
個々のボタンのオン/オフではなく、グループ全体での状態が数値で、
a) 排他指定の場合
オン(凹)のボタン番号(全てオフならばゼロ)
b) 排他していない場合
[全てオフ:ゼロ] [1個だけオン:オンのボタン番号] [複数オン: -1 ]
という風に返ります。
Private Sub cmdValue1_Click()
Dim i As Integer
Dim strWK As String
strWK = "(" & clsTglLbl_Week1(vbSunday).GrpValue & ") "
For i = vbSunday To vbSaturday ' vbSunday(1) 〜 vbSaturday(7)
If (clsTglLbl_Week1( i ).Value = True) Then
strWK = strWK & "■"
Else
strWK = strWK & "□"
End If
Next i
MsgBox strWK ' ( n ) □□□□■□□ というメッセージ
End Sub
(clsTglLbl_Week2 のコードも同じなので省略)
7.ボタンの状態をVBAからオン/オフ(凹凸)するには、そのボタンのクラスオブジェクトに
対して[Value]プロパティを通して行ないます。排他指定の場合、True を代入すると、
それまでオン(凹)になっていたボタンはオフ(凸)になります。
同じグループ内の代表となるボタン(どれでも構いません)のクラスオブジェクトに対して、
[OnValueSet / OffValueSet]メソッドを行なう事でもオン/オフを設定できます。
その際、引数にボタン番号を指定するか否かで、2種類の使い方が出来ます。
・ボタン番号を指定
指定したボタン番号に対してオン/オフを設定できます。
この場合に設定されるのは、クラスオブジェクト側に指定したボタンに対してではなく、
[OnValueSet/OffValueSet]メソッド側に指定したボタン番号のボタンに対してです。
・ボタン番号を省略/ゼロ
グループ全体に対して、一度にオン/オフを設定出来ます([排他]指定の場合、
OnValueSetメソッドでボタン番号を省略/ゼロにしてもボタンの状態は変わりません)。
'火曜をオン(排他なので、オン中の他ボタンはオフになる)
clsTglLbl_Week1(vbTuesday).Value = True
'金曜をオフ(排他に係わり無く、指定したボタンはオフになる)
clsTglLbl_Week1(vbFriday).Value = False
'全体をオン(排他なので効果なし)
clsTglLbl_Week1(vbSunday).OnValueSet
'全体をオフ(排他に係わり無く、全ボタンはオフになる)
clsTglLbl_Week1(vbSunday).OffValueSet
'火曜をオン(排他ではないので、オン中の他ボタンはそのまま)
clsTglLbl_Week2(vbTuesday).Value = True
'金曜をオフ(排他に係わり無く、指定したボタンはオフになる)
clsTglLbl_Week2(vbFriday).Value = False
'全体をオン(排他ではないので、全ボタンはオンになる)
clsTglLbl_Week2(vbSunday).OnValueSet
'全体をオフ(排他に係わり無く、全ボタンはオフになる)
clsTglLbl_Week2(vbSunday).OffValueSet
8.同じグループ内の代表となるボタン(どれでも構いません)のクラスオブジェクトに対して、
[GrpEnabled ]プロパティにTrue/False を指定する事で、グループ全体の操作可否を
設定できます。他に[Enabled ]プロパティでボタンごとに指定する事も可能です。
Private Sub cmdTrue1_Click()
clsTglLbl_Week1(vbSunday).GrpEnabled = True
End Sub
Private Sub cmdFalse1_Click()
clsTglLbl_Week1(vbSunday).GrpEnabled = False
End Sub
(clsTglLbl_Week2 のコードも同じなので省略)
9.[clsTglLabelEx]クラスでは、マウスクリック時と、ボタン状態変化時に、[RaiseEvent ]ステー
トメントを使って、[clsTglLabelEx]クラス専用のカスタムイベントを発生させています。これを親
クラスの[clsTglLblGrp]クラスで、各々Click イベント/Change イベントとして受け取り、更に
利用元であるUserFormへと Click イベント/Change イベントを上げています。
Excel97 の場合、ラベルのClick イベントを取得する所までは出来ます(ラベルコントロール
定義でのWithEvents 宣言)が、それを利用元へ送り出すカスタムイベントが作れません。
(Excel97 では、[RaiseEvent ]ステートメントが使えない為)
そこで、イベント処理の根本的な仕組みである
a ) 下位モジュールでは、只々、イベント発生をシステムのイベントキュー(待ち行列)に放り込む
だけで、「後は、上位モジュールよ、勝手にどうぞ」と突き放す
b ) 上位モジュールは、只々、システムからイベントキューにイベントが入ったという知らせを待ち
続け、通知が来たらキューからイベントを受け取って処理する
という間接的/放任主義的な流れ(下位と上位モジュールに直接的な繋がりは無い)の
代わりに、
『上位モジュール内に受付窓口となるルーチンを設け』
『下位モジュールは直接その窓口へ通知を送る』
という風にします。
そうなれば当然「窓口を決めておく」必要がありますので、その名前を
【 clsTglLabel__Click 】 【 clsTglLabel__Change 】
と固定にします(アンダーバーを2つ繋げているのは万が一にも名前の重複を避ける為です)。
上位(UserForm)では、この名前で Sub プロシジャーを定義(Public )しておけば、下位
( clsTglLabel クラス)から直接通知が届くという流れになります。
UserFormモジュールの外から、UserFormモジュール内のプロシジャーをCall するには、
Call UserForm1.xxxxxx( 引数リスト )
という風にUserForm名で修飾する必要があります。そこで、5項で説明した[Caller ]プロ
パティの内容によって下記のように分岐処理を記述します。[ clsTglLabel ]クラスを使用す
るUserFormの数だけ分岐を用意する必要があります。
(補足説明)
下記のようなオブジェクト変数を用意して
Dim MyForm As MsForms.UserForm
この変数に呼び元のUserFormを設定しておけば
Call MyForm.clsTglLabel__Click ( 引数リスト )
という記述で、分岐処理を用意する必要もないのでは? と思えますが、残念な事に、
この記述は構文エラーになります。それでは代わりにと、Select Case ステートメントを
Select Case MyForm.Name
Case "abc" : Call abc.clsTglLabel__Click ( 引数リスト )
という風にしてみると、今度は、MyForm というオブジェクト変数に対しては「Name プロ
パティ」が使えません。
という事で、[Caller ]プロパティは String型とし、呼び元のUserForm側で[Me.Name]を
設定して貰う事になりました。
【 クラスモジュール[clsTglLabel ]側で直す部分 】
'---( 宣言セクション )--------------------------------------
Private WithEvents MyLabel As MSForms.Label 'トグル化させるラベル
'---( 自[Label]のClick イベント )--------------------------------------
Private Sub MyLabel_Click()
If (Me.Value = True) Then
Me.Value = False '凹→凸
Else
Me.Value = True '凸→凹
End If
'※ [clsTglLabel]クラスでは呼び元のUserFormに用意してある通知受領サブを
' Callする呼び出し元となるUserFormの分だけ、UserForm名での修飾を変えて
' 記述する(名前の重複を防ぐ為に敢えてアンダーバーを2つ繋げている)
Select Case MyCaller
Case "frmTglLabel"
Call frmTglLabel.clsTglLabel__Click _
(MyIndex, MyLabel, Me.Value, MyGrpID)
Case "frmTglLabel_2"
Call frmTglLabel_2.clsTglLabel__Click _
(MyIndex, MyLabel, Me.Value, MyGrpID)
'Case "xxxxx"
' Call xxxxx.clsTglLabel__Click _
' (MyIndex, MyLabel, Me.Value, MyGrpID)
Case Else
End Select
End Sub
'---( SpecialEffect更新/Changeイベント発生 )------------------------
Private Sub ValueChange _
(ByVal Btn_Index As Integer, _
ByVal UpdValue As Integer)
Dim blnMyEvent As Boolean
If (MyLabelGroup(Btn_Index).SpecialEffect <> UpdValue) Then
MyLabelGroup(Btn_Index).SpecialEffect = UpdValue
If (Btn_Index = MyIndex) Then
blnMyEvent = True
Else
blnMyEvent = False
End If
'※ [clsTglLabel]クラスでは呼び元のUserFormに用意してある通知受領サブを
' Callする呼び出し元となるUserFormの分だけ、UserForm名での修飾を変えて
' 記述する(名前の重複を防ぐ為に敢えてアンダーバーを2つ繋げている)
Select Case MyCaller
Case "frmTglLabel"
Call frmTglLabel.clsTglLabel__Change _
(Btn_Index, MyLabelGroup(Btn_Index), _
Me.GrpValue(Btn_Index), MyGrpID, blnMyEvent)
Case "frmTglLabel_2"
Call frmTglLabel_2.clsTglLabel__Change _
(Btn_Index, MyLabelGroup(Btn_Index), _
Me.GrpValue(Btn_Index), MyGrpID, blnMyEvent)
'Case "xxxxx"
' Call xxxxx.clsTglLabel__Change _
' (Btn_Index, MyLabelGroup(Btn_Index), _
' Me.GrpValue(Btn_Index), MyGrpID, blnMyEvent)
Case Else
End Select
Else
'値が変わらないので、そのまま
End If
End Sub
10.上記 9項の仕組みによって、呼び元のUserFormでは[clsTglLabel ]クラスからイベントを通知
して貰えます。UserForm側には、決まった名前である
clsTglLabel__Click と clsTglLabel__Change
の2つの[Public Sub]プロシジャーを用意します(複数のUserformから利用する場合であっても、
個々のUserFormモジュール内での名前は全て同じです)。
利用元で、クリックイベント/チェンジイベントが必要ない場合であっても、このイベント通知受領
用の窓口ルーチン自体は記述する必要があります。その場合は「処理を記述しない、空ルーチ
ン」として下さい。
自UserForm上に複数のグループが有っても、[clsTglLabel ]クラスから通知を受け取るルーチン
は、Click とChange で各々1つだけです。そこで、引数で受け取る[グループID]によって、下記
のように、各グループの『イベント用プロシジャー』へ振り分けてやる必要があります。
【 ユーザーフォーム側で直す部分 】
'[clsTglLabel]クラスからイベント通知を受け取るサブルーチン
'(名前の重複を防ぐ為に敢えてアンダーバーを2つ繋げている)
Public Sub clsTglLabel__Click _
(ByVal Index As Integer, _
ByVal Btn_Label As MSForms.Label, _
ByVal Btn_Value As Boolean, _
ByVal GrpId As String)
Select Case GrpId
Case "Week1"
Call clsTglLbl_Week1_Click (Index, Btn_Label, Btn_Value)
Case "Week2"
Call clsTglLbl_Week2_Click (Index, Btn_Label, Btn_Value)
' Case "yyyy"
' Call clsTglLbl_yyyy_Click (Index, Btn_Label, Btn_Value)
Case Else
End Select
End Sub
Public Sub clsTglLabel__Change _
(ByVal Index As Integer, _
ByVal Btn_Label As MSForms.Label, _
ByVal Btn_Value As Boolean, _
ByVal GrpId As String, _
ByVal MyEvent As Boolean)
Select Case GrpId
Case "Week1"
Call clsTglLbl_Week1_Change (Index, Btn_Label, Btn_Value)
Case "Week2"
Call clsTglLbl_Week2_Change (Index, Btn_Label, Btn_Value)
' Case "yyyy"
' Call clsTglLbl_yyyy_Change (Index, Btn_Label, Btn_Value)
Case Else
End Select
End Sub
11.[clsTglLabel]クラスは、ボタンをマウスクリックした際に『Click イベント』を発生させます。
このClick イベントに対するプロシジャーとは、上記 10項で分岐Call しているものです。
Click イベントは、次項解説の Change イベントの後に発生します。
このイベント内で、クリックしたボタンに対して、何らかの操作を行なう場合は、[Btn_Label]
を通して行なう事が出来ます。
[Index]引数にはクリックしたラベルの番号(Add メソッドで登録した順番[1〜])、
[Btn_Label]引数にはクリックしたラベルのラベルオブジェクト、
[Btn_Value]引数にはクリックした結果のオン/オフ(True/False)が返ります。
'[clsTglLabel]クラスの場合は、このフォーム内に用意した
'イベント通知受領サブ[clsTglLabel__Click]を通じてCallされる
Private Sub clsTglLbl_Week1_Click _
(ByVal Index As Integer, _
ByVal Btn_Label As MSForms.Label, _
ByVal Btn_Value As Boolean)
lblClick1.Caption = vntWeek(Index) & ":" & Btn_Value
End Sub
(clsTglLbl_Week2 のコードも同じなので省略)
12.[clsTglLabel]クラスは、ボタンの状態が変化した際に『Change イベント』を発生させます。
このChange イベントに対するプロシジャーとは、上記 10項で分岐Call しているものです。
Change イベントは、マウスクリックや OnValueSet/OffValueSet メソッドにより、ボタンの状態
(オン:凹/オフ:凸)が変化(凹⇔凸)した際に発生します。
Change イベントの発生は、1回の操作(クリックやメソッド実行)に対して1回とは限りません。
その操作によって状態が変化した全てのボタンに対する Change イベントが繰り返し発生
します。
例えば、排他有りの場合に、クリックでボタンをオンにすれば、そのボタンの他に、それまで
オンだったボタン(オフに変わります)の2つで Change イベントが続けて発生します(2つの
Change イベントが発生した後に、クリックしたボタンに対する Click イベントが発生します)。
このイベント内で、状態の変化したボタンに対して、何らかの操作を行なう場合は、[Btn_Label]
を通して行う事が出来ます。
[Index]引数には状態の変化したラベルの番号(Add メソッドで登録した順番[1〜])、
[Btn_Label]引数には状態の変化したラベルのラベルオブジェクト、
[Btn_Value]引数には状態変化した後のオン/オフ(True/False)が返ります。
一度の操作により変化した[ボタンの全て]で Change イベントが発生しますので、上記のコード
Private Const cstON As Long = vbWhite
Private Const cstOFF As Long = &HFFFF& ' 黄
'[clsTglLabel]クラスの場合は、このフォーム内に用意した
'イベント通知受領サブ[clsTglLabel__Change]を通じてCallされる
Private Sub clsTglLbl_Week1_Change _
(ByVal Index As Integer, _
ByVal Btn_Label As MSForms.Label, _
ByVal Btn_Value As Boolean)
If (Btn_Value = True) Then
Btn_Label.BackColor = cstON
Else
Btn_Label.BackColor = cstOFF
End If
End Sub
(clsTglLbl_Week2 のコードも同じなので省略)
だけで、排他時のマウスクリックで起きる「2つのボタンのオン化/オフ化という同時変化」にも対
応している事になります。
13.(12)項では、イベントサンプルとして、ボタンカラーの変更を Change イベントによって行いま
したが、『第2版』において、ボタンカラーの自動変更 および ボタンの初期状態(凹凸)の指定
を行なう [ Init ] メソッドを追加しました。
サンプルブックでは「子フォーム」の方で使っていますので参考にしてください。
Set colTglLbl_年代 = New Collection
With colTglLbl_年代
.Add lblAge10
.Add lblAge20
.Add lblAge30
.Add lblAge40
.Add lblAge50
End With
For i = 1 To colTglLbl_年代.Count
Set clsTglLbl_年代( i ) = New clsTglLabel
With clsTglLbl_年代( i )
.Rgst colTglLbl_年代( i ), i, colTglLbl_年代, "年代", True '『排他』あり
.Caller = Me.Name '呼び元のUserForm名
.Init vbYellow, vbDesktop, Array( False, False, True, False, False )
End With
Next i
Set colTglLbl_科目 = New Collection
With colTglLbl_科目
.Add lbl国語
.Add lbl算数
.Add lbl理科
.Add lbl社会
.Add lbl英語
End With
For i = 1 To colTglLbl_科目.Count
Set clsTglLbl_科目( i ) = New clsTglLabel
With clsTglLbl_科目( i )
.Rgst colTglLbl_科目( i ), i, colTglLbl_科目, "科目", False '『排他』なし
.Caller = Me.Name '呼び元のUserForm名
.Init vbCyan, vbButtonFace, Array( True, False, True, True, False )
End With
Next i
14.(11) (12)項で説明したように、この[clsTglLabel]クラスでは、同一グループ内の複数のボタン
(ラベル)に対するイベント処理を、UserFormモジュール内に
『 たった、ひとつの(偽)イベントプロシジャー 』
を記述するだけで済ませる事ができます。従来はクラスモジュール内にイベントプロシジャー
を記述する「見掛け上の、ひとつのイベントプロシジャー」で対応して来ました(UserFormモ
ジュール内にイベントプロシジャーは書かない)。
VBA/UserFormでの「擬似コントロール配列」を越え、VB並に「コントロール配列」に準ずる
記述/操作が可能な、この手法の解説は
特集記事 : 『擬似』からの脱却
を参照してください。
15.このサンプルは『曜日』ボタンなので、インデックス番号を表すものとして[vbSunday(1) 〜
vbSaturday(7)]を使いました。このようにインデックス番号には、直接番号を記述せず、意味
の判る定数名を利用した方がコードの可読性が高くなります。Excel2000以上ならば列挙型
(Enum)が便利です。Excel97では列挙型が利用できないのでConst 定数を使って下さい。
Private Enum en科目
en国語 = 1
en算数 = 2
en理科 = 3
en社会 = 4
en英語 = 5
End Enum
Private Const cst国語 As Integer = 1
Private Const cst算数 As Integer = 2
Private Const cst理科 As Integer = 3
Private Const cst社会 As Integer = 4
Private Const cst英語 As Integer = 5
[ clsTglLblGrp ] [ clsTglLabelEx/clsTglLabel ] クラスのリファレンス解説ページ
|
||
角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2001 Allrights Reserved. |