第24回.イベントプロシージャーの共通化(Enter,Exit)
ユーザーフォームのVBAでは、同じイベントプロシージャーを何個も作成することが多々あります。
テキストボックスを複数個配置して同じイベント処理を実装する時、全く同じイベントプロシージャーをコピペで何個も作るといったことが必要になります。
第23回.イベントプロシージャーの共通化
今回は、この問題点を解決する方法を紹介します。
イベントプロシージャーの共通化の問題点
したがって、コントロールの種類ごとにWithEventsを定義する必要があります。
使えるイベントに制限があります
Text Box |
Check Box |
Option Button |
Combo Box |
List Box |
Command Button |
|
AfterUpdate | × | × | × | × | × | - |
BeforeDragOver | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
BeforeDropOrPaste | × | × | × | × | × | × |
BeforeUpdate | × | × | × | × | × | - |
Change | 〇 | 〇 | 〇 | 〇 | 〇 | - |
Click | - | 〇 | 〇 | 〇 | 〇 | 〇 |
DblClick | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
DropButtonClick | 〇 | - | - | 〇 | - | - |
Enter | × | × | × | × | × | × |
Exit | × | × | × | × | × | × |
KeyDown | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
KeyPress | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
KeyUp | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
MouseDown | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
MouseMove | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
MouseUp | 〇 | 〇 | 〇 | 〇 | 〇 | 〇 |
×:使用できません。
-:元々イベントが存在しません。
Enter
Exit
このあたりが使用できないところが厳しいところです。
例えば、
第16回.アクティブコントロールに色を付ける
問題解決した経緯
このツイートでリンクされている先は、
http://addinbox.sakura.ne.jp/Temp/EventHandling_C2CP.htm
AddinBoxという有名なサイトです。
教えていただいたリンクは、
http://addinbox.sakura.ne.jp/Bpca_Common.htm#C2CP
https://web.archive.org/web/20120911012129/http://moug.net/faq/viewtopic.php?t=62306
https://web.archive.org/web/20120911231242/http://moug.net/faq/viewtopic.php?t=62566
https://web.archive.org/web/20130115194304/http://moug.net/faq/viewtopic.php?t=62720
https://web.archive.org/web/20130514173245/http://moug.net/faq/viewtopic.php?t=64302
https://web.archive.org/web/20150322143040/http://moug.net/faq/viewtopic.php?t=68110
今回の件については、一番下の(5)がとても参考になります。
API:ConnectToConnectionPointについて
http://msdn.microsoft.com/en-us/library/windows/desktop/bb773794(v=vs.85).aspx
詳細の解説はとてもできそうにないので、知りたい方はリンクを辿って各自で調べてみてください。
VBAクラス研究室(5)
https://web.archive.org/web/20150322143040/http://moug.net/faq/viewtopic.php?t=68110
この中の真ん中位に、
「…UserForm上すべてのTextBoxに対してイベントを接続させ、イベント名とConnectionPointContainer名(今回だと対象TextBox名)を列挙します。」
として、VBAの全コードが掲載されています。
32bit用のVBAとなっていますが、そのまま動かすことができます。
このVBAの内容を一つずつ調べていくと理解が進むと思いますが、
ただし、この全てを理解するのはとても大変だと思います・・・
ConnectToConnectionPointの使用例
フォーム上の全てのコントロールについて、
フォーカスを受け取った時に背景色を変えて、フォーカスを失ったときに色を戻します。
使用例という事もあり、EnterイベントとExitイベントのペアでVBAを書きました。
クラスモジュール
詳細については、
VBAクラスのAttributeについて(既定メンバーとFor Each)
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsEvent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'API定義 [ ConnectToConnectionPoint ]
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
(ByVal pUnk As stdole.IUnknown, ByRef riidEvent As GUID, _
ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, _
ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
Private Cookie As Long
Private MyCtrl As Object 'イベント接続するコントロール
'イベント接続
Public Property Set Control(NewCtrl As Object)
Set MyCtrl = NewCtrl
Call ConnectEvent(True)
End Property
'イベント切断
Public Sub Clear()
If (Cookie <> 0) Then
Call ConnectEvent(False)
End If
Set MyCtrl = Nothing
End Sub
'イベント接続切断
Private Sub ConnectEvent(ByVal Connect As Boolean)
Dim IID_IDispatch As GUID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
ConnectToConnectionPoint Me, IID_IDispatch, Connect, MyCtrl, Cookie, 0&
End Sub
'Enterイベントで背景色設定
Public Sub Event_Enter()
Attribute Event_Enter.VB_UserMemId = -2147384830
If TypeName(MyCtrl) = "Frame" Then Exit Sub
MyCtrl.Tag = MyCtrl.BackColor
MyCtrl.BackColor = RGB(255, 153, 204)
End Sub
'Exitイベントで背景色戻し
Public Sub Event_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Attribute Event_Exit.VB_UserMemId = -2147384829
Dim ctl As Control
If TypeName(MyCtrl) = "Frame" Then
For Each ctl In MyCtrl.Controls
If ctl.Tag <> "" Then ctl.BackColor = ctl.Tag
Next
Else
MyCtrl.BackColor = MyCtrl.Tag
End If
End Sub
Attribute Event_Enter.VB_UserMemId = -2147384830
Attribute Event_Exit.VB_UserMemId = -2147384829
この2行がそれぞれのイベントプロシージャーに対するID数値の設定になります。
引数とVB_UserMemIdだけは一致させてください。
Option Explicit
'API定義 [ ConnectToConnectionPoint ]
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" _
(ByVal pUnk As stdole.IUnknown, ByRef riidEvent As GUID, _
ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, _
ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
Private Cookie As Long
Private MyCtrl As Object 'イベント接続するコントロール
'イベント接続
Public Property Set Control(NewCtrl As Object)
Set MyCtrl = NewCtrl
Call ConnectEvent(True)
End Property
'イベント切断
Public Sub Clear()
If (Cookie <> 0) Then
Call ConnectEvent(False)
End If
Set MyCtrl = Nothing
End Sub
'イベント接続切断
Private Sub ConnectEvent(ByVal Connect As Boolean)
Dim IID_IDispatch As GUID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
ConnectToConnectionPoint Me, IID_IDispatch, Connect, MyCtrl, Cookie, 0&
End Sub
'Enterイベントで背景色設定
Public Sub Event_Enter()
If TypeName(MyCtrl) = "Frame" Then Exit Sub
MyCtrl.Tag = MyCtrl.BackColor
MyCtrl.BackColor = RGB(255, 153, 204)
End Sub
'Exitイベントで背景色戻し
Public Sub Event_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim ctl As Control
If TypeName(MyCtrl) = "Frame" Then
For Each ctl In MyCtrl.Controls
If ctl.Tag <> "" Then ctl.BackColor = ctl.Tag
Next
Else
MyCtrl.BackColor = MyCtrl.Tag
End If
End Sub
フォームモジュール
Option Explicit
'イベント補足クラスのコレクション
Private colEvent As New Collection
Private Sub UserForm_Initialize()
Dim clsEvent As clsEvent
Dim ctl As Control
For Each ctl In Me.Controls
Set clsEvent = New clsEvent
Set clsEvent.Control = ctl
colEvent.Add clsEvent
Next
End Sub
Private Sub UserForm_Terminate()
Dim clsEvent As clsEvent
Dim ctl As clsEvent
For Each ctl In colEvent
ctl.Clear
Next
Set colEvent = Nothing
End Sub
フォームを作成して、適当にいろいろなコントロールを配置し動作確認してください。
元の色はTagプロパティに保存するようにしています。
ここはやり方がいろいろありますが、Tagプロパティの使い方の紹介も兼ねてこのようにしてみました。
フレーム外に移った時、フレーム内の選択コントロールはフォーカスを失いません。
上記では、無理やり色を戻していますので、
フレーム内の先頭コントロールからフレーム外に移り、再度フレームに戻った時は先頭コントロールに色が付きません。
今回の趣旨から外れるのでVBAを複雑にしないために、この細部の挙動についての対応はしていません。
もし実際に使うのであれば、フレーム内の最終コントロールを別途保存しておくといった方法等をかんがえる必要があります。
イベントと対応するVB_UserMemIdの一覧とインポート用雛形
VB_UserMemIdの一覧
イベント | 16進 | 10進 |
Change | &H2 | 2 |
BeforeDragOver | &H3 | 3 |
BeforeDropOrPaste | &H4 | 4 |
Click | &HFFFFFD9E | -610 |
DblClick | &HFFFFFDA7 | -601 |
KeyDown | &HFFFFFDA6 | -602 |
KeyPress | &HFFFFFDA5 | -603 |
KeyUp | &HFFFFFDA4 | -604 |
MouseDown | &HFFFFFDA3 | -605 |
MouseMove | &HFFFFFDA2 | -606 |
MouseUp | &HFFFFFDA1 | -607 |
Error | &HFFFFFDA0 | -608 |
Exit | &H80018203 | -2147384829 |
Enter | &H80018202 | -2147384830 |
BeforeUpdate | &H80018201 | -2147384831 |
AfterUpdate | &H80018200 | -2147384832 |
DropButtonClick | &H7D2 | 2002 |
クラスのインポート用雛形
Private Sub Event_Enter()
Attribute Event_Enter.VB_UserMemId = -2147384830
End Sub
Private Sub Event_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Attribute Event_Enter.VB_UserMemId = -2147384829
End Sub
Private Sub Event_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Attribute Event_Enter.VB_UserMemId = -2147384831
End Sub
Private Sub Event_AfterUpdate()
Attribute Event_Enter.VB_UserMemId = -2147384832
End Sub
Private Sub Event_Change()
Attribute Event_Enter.VB_UserMemId = 2
End Sub
Private Sub Event_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
Attribute Event_Enter.VB_UserMemId = 3
End Sub
Private Sub Event_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
Attribute Event_Enter.VB_UserMemId = 4
End Sub
Private Sub Event_Click()
Attribute Event_Enter.VB_UserMemId = -610
End Sub
Private Sub Event_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Attribute Event_Enter.VB_UserMemId = -601
End Sub
Private Sub Event_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Attribute Event_Enter.VB_UserMemId = -602
End Sub
Private Sub Event_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Attribute Event_Enter.VB_UserMemId = -603
End Sub
Private Sub Event_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Attribute Event_Enter.VB_UserMemId = -604
End Sub
Private Sub Event_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Attribute Event_Enter.VB_UserMemId = -605
End Sub
Private Sub Event_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Attribute Event_Enter.VB_UserMemId = -606
End Sub
Private Sub Event_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Attribute Event_Enter.VB_UserMemId = -607
End Sub
Private Sub Event_DropButtonClick()
Attribute Event_Enter.VB_UserMemId = 2002
End Sub
イベントプロシージャーの共通化の最後に
クラスを使った難解なVBAになってしまうので、気軽に使うという類のものではないようにも思います。
今回は、もし必要になった時の参考として、ここにまとめておきました。
ぜひ一度、実際に動かしてその挙動を確認してみてください。
同じテーマ「ユーザーフォーム入門」の記事
第17回.Enterキーで次のコントロールに移動する
第18回.2段階のコンボボックス
第19回.数値専用のテキストボックス
第20回.テキストボックスの各種イベント
第21回.ユーザーフォームの各種イベント
第22回.コントロールの動的作成
第23回.イベントプロシージャーの共通化
第24回.イベントプロシージャーの共通化(Enter,Exit)
第25回.簡易音楽プレーヤーの作成
第26回.プログレスバーを自作する
第27回.インクリメンタルサーチの実装
新着記事NEW ・・・新着記事一覧を見る
VBA100本ノック 100本目:WEBから100本ノックのリストを取得|VBA練習問題(3月3日)
VBA100本ノック 99本目:自動席替え(行列と前後左右が全て違うように)|VBA練習問題(3月2日)
VBA100本ノック 98本目:席替えルールが守られているか確認|VBA練習問題(3月1日)
VBA100本ノック 97本目:Accessデータを取得(グループ集計)|VBA練習問題(2月27日)
VBA100本ノック 96本目:Accessデータを取得(マスタ結合&抽出)|VBA練習問題(2月26日)
VBA100本ノック 95本目:図形のテキストを検索するフォーム作成|VBA練習問題(2月24日)
VBA100本ノック 94本目:表範囲からHTMLのtableタグを作成|VBA練習問題(2月23日)
VBA100本ノック 93本目:複数ブックを連結して再分割|VBA練習問題(2月22日)
VBA100本ノック 92本目:セルの色を16進で返す関数|VBA練習問題(2月20日)
VBA100本ノック 91本目:時間計算(残業時間の月間合計)|VBA練習問題(2月19日)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
6.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.マクロはどこに書くの(VBEの起動)|VBA入門
10.とにかく書いてみよう(Sub,End Sub)|VBA入門
- ホーム
- マクロVBA応用編
- ユーザーフォーム入門
- イベントプロシージャーの共通化(Enter,Exit)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。