[Access VBA] フォームのコントロールに対してWithEventsでイベントリスナークラスを作成する際に気をつけなければならないこと

Nov 8, 2020 · この記事は約7分で読めます · Access VBA 自作オブジェクト指向 ·

Share on:

概要

この記事について

Accessでフォーム上のコントロール（テキストボックス、コンボボックスなど）で、イベント処理を共通化するためにWithEventsステートメントを用いてイベントリスナークラスを作成することを考える。

その際に、ExcelでWitheventsを使用するときと同じようなコードで作成すると、
せっかく設定したクラス側のイベントが発火してくれない事態が生じた。

その事例と、講じた対策二種類について記したい。

説明のために作成したAccessファイルとソースコードはこちらでダウンロードできます。

事例

次のような画面とコードで、
丸囲みのコンボボックスをキーボード入力できないようにする。
（先に正常に動かないコードのほうを示す）

共通化のために、
コンボボックスのKeyDownイベント関数をクラス化する。

検証のために、コンボボックスのイベント発火をトレースし、
テキストボックスにログを出力できるようにした。

画面

オブジェクトのプロパティ

名前	種類	説明
cmb_withEventsTest	コンボボックス	直接のキーボード入力を禁止する
txt_EventLog	テキストボックス	コンボボックスのイベントログが表示される

コード

下記コードは正常に動かない（myComboBox_KeyDown関数が発火しない）

フォームモジュール：MainForm

  1Option Compare Database
  2Option Explicit
  3
  4'**************************
  5'*MainForm
  6'**************************
  7
  8'定数
  9
 10
 11'変数
 12Private objCmbListener As clsCmbListener
 13
 14
 15
 16'******************************************************************************************
 17'*getter/setter
 18'******************************************************************************************
 19
 20
 21
 22
 23'******************************************************************************************
 24'*関数名    ：Form_Load
 25'*機能      ：
 26'*引数(1)   ：
 27'******************************************************************************************
 28Private Sub Form_Load()
 29    
 30    '定数
 31    Const FUNC_NAME As String = "Form_Load"
 32    
 33    '変数
 34    Dim dicInfo As Object
 35    
 36    On Error GoTo ErrorHandler
 37
 38    'イベントクラス設定
 39    Set objCmbListener = New clsCmbListener: Set objCmbListener.ComboBox = Me.cmb_withEventsTest
 40    'イベントログ設定
 41    Set M_EventLog.targetTxtBox = Me.txt_EventLog
 42    
 43ExitHandler:
 44
 45    Exit Sub
 46    
 47ErrorHandler:
 48
 49    MsgBox "エラーが発生したため、マクロを終了します。" & _
 50           vbLf & _
 51           "関数名：" & FUNC_NAME & _
 52           vbLf & _
 53           "エラー番号：" & Err.Number & vbNewLine & _
 54           Err.Description, vbCritical, "Access-Control-WithEvents"
 55        
 56    GoTo ExitHandler
 57        
 58End Sub
 59
 60
 61'******************************************************************************************
 62'*関数名    ：cmb_withEventsTest_BeforeUpdate
 63'*機能      ：
 64'*引数(1)   ：
 65'******************************************************************************************
 66Private Sub cmb_withEventsTest_BeforeUpdate(Cancel As Integer)
 67    
 68    '定数
 69    Const FUNC_NAME As String = "cmb_withEventsTest_BeforeUpdate"
 70    
 71    '変数
 72    
 73    On Error GoTo ErrorHandler
 74
 75    'ログに記入
 76    If Not M_EventLog.writeEventLogs(FUNC_NAME) Then GoTo ExitHandler
 77
 78ExitHandler:
 79
 80    Exit Sub
 81    
 82ErrorHandler:
 83
 84    MsgBox "エラーが発生したため、マクロを終了します。" & _
 85           vbLf & _
 86           "関数名：" & FUNC_NAME & _
 87           vbLf & _
 88           "エラー番号：" & Err.Number & vbNewLine & _
 89           Err.Description, vbCritical, "Access-Control-WithEvents"
 90        
 91    GoTo ExitHandler
 92        
 93End Sub
 94
 95
 96'******************************************************************************************
 97'*関数名    ：cmb_selectedRcd_AfterUpdate
 98'*機能      ：
 99'*引数(1)   ：
100'******************************************************************************************
101Private Sub cmb_withEventsTest_AfterUpdate()
102    
103    '定数
104    Const FUNC_NAME As String = "cmb_selectedRcd_AfterUpdate"
105    
106    '変数
107    
108    On Error GoTo ErrorHandler
109    
110    'ログに記入
111    If Not M_EventLog.writeEventLogs(FUNC_NAME) Then GoTo ExitHandler
112    If Not M_EventLog.writeEventLogs("""" & Me.cmb_withEventsTest.Value & """" & "Selected") Then GoTo ExitHandler
113
114ExitHandler:
115
116    Exit Sub
117    
118ErrorHandler:
119
120    MsgBox "エラーが発生したため、マクロを終了します。" & _
121           vbLf & _
122           "関数名：" & FUNC_NAME & _
123           vbLf & _
124           "エラー番号：" & Err.Number & vbNewLine & _
125           Err.Description, vbCritical, "Access-Control-WithEvents"
126        
127    GoTo ExitHandler
128        
129End Sub
130
131
132

クラス：clsCmbListener

 1Option Compare Database
 2Option Explicit
 3
 4'**************************
 5'*コンボボックスイベントリスナー
 6'**************************
 7
 8'定数
 9
10'変数
11Private WithEvents myComboBox As Access.ComboBox
12
13'******************************************************************************************
14'*getter/setter
15'******************************************************************************************
16Public Property Set ComboBox(ByRef cmb As Access.ComboBox)
17    Set myComboBox = cmb
18End Property
19
20
21
22
23
24'******************************************************************************************
25'*関数名    ：myComboBox_KeyDown
26'*機能      ：キー入力を無効にする
27'*引数(1)   ：
28'******************************************************************************************
29Private Sub myComboBox_KeyDown(KeyCode As Integer, Shift As Integer)
30    
31    '定数
32    Const FUNC_NAME As String = "myComboBox_KeyDown"
33    
34    '変数
35    
36    On Error GoTo ErrorHandler
37    
38    'キー入力を無効にする(Enter/Tab/Esc以外)
39    If KeyCode = vbKeyReturn Then GoTo ExitHandler
40    If KeyCode = vbKeyTab Then GoTo ExitHandler
41    If KeyCode = vbKeyEscape Then GoTo ExitHandler
42    
43    KeyCode = 0
44    
45    If Not M_EventLog.writeEventLogs(FUNC_NAME) Then GoTo ExitHandler
46    
47ExitHandler:
48
49    Exit Sub
50    
51ErrorHandler:
52
53    MsgBox "エラーが発生したため、マクロを終了します。" & _
54           vbLf & _
55           "関数名：" & FUNC_NAME & _
56           vbLf & _
57           "エラー番号：" & Err.Number & vbNewLine & _
58           Err.Description, vbCritical, "Access-Control-WithEvents"
59        
60    GoTo ExitHandler
61        
62End Sub
63
64

モジュール：M_EventLog

 1Option Compare Database
 2Option Explicit
 3
 4
 5'**************************
 6'*イベントログModule
 7'**************************
 8
 9'定数
10
11
12'変数
13Public targetTxtBox As Access.TextBox
14
15
16'******************************************************************************************
17'*関数名    ：writeEventLogs
18'*機能      ：テキストボックスにイベントログを書き込む
19'*引数(1)   ：記入文字列
20'*戻り値    ：True > 正常終了、False > 異常終了
21'******************************************************************************************
22Public Function writeEventLogs(ByVal logTxt As String) As Boolean
23    
24    '定数
25    Const FUNC_NAME As String = "writeEventLogs"
26    
27    '変数
28    
29    On Error GoTo ErrorHandler
30
31    writeEventLogs = False
32    
33    If Nz(targetTxtBox.Value, "") <> "" Then targetTxtBox.Value = targetTxtBox.Value & vbNewLine
34    targetTxtBox.Value = targetTxtBox.Value & _
35                         Now & _
36                         " : " & _
37                         logTxt
38    
39    writeEventLogs = True
40    
41ExitHandler:
42
43    Exit Function
44    
45ErrorHandler:
46
47    MsgBox "エラーが発生したため、マクロを終了します。" & _
48           vbLf & _
49           "関数名：" & FUNC_NAME & _
50           vbLf & _
51           "エラー番号：" & Err.Number & vbNewLine & _
52           Err.Description, vbCritical, "Access-Control-WithEvents"
53        
54    GoTo ExitHandler
55        
56End Function
57
58
59
60

トラブル

コンボボックスのKeyDownイベントは、WithEventsによって
[clsCmbListener]クラスのもつmyComboBox_KeyDown関数で補足され、
EnterやTabなどの一部のキー以外はキー入力が禁止されるはずである。

ところが、コンボボックスに直接のキーボード入力ができてしまう。

入力できてしまう

さらに、テキストボックスに
myComboBox_KeyDown関数が呼出されたログが表示されていないため、
そもそもWithEventsの想定通りの動作が起こっていないことになる。

ExcelのWithEventsの場合は、上に記したようなコードで動作したため、
しばらくどう対応したものか悩んだ。

解決方法

i. フォームモジュールの方にもKeyDownイベント関数を追加する

内容

つまり、下記のように処理が空である関数を追加する。

 1Option Compare Database
 2Option Explicit
 3
 4'**************************
 5'*MainForm
 6'**************************
 7
 8'定数
 9
10
11'変数
12Private objCmbListener As clsCmbListener
13
14'~~~~~~~~略~~~~~~~~
15
16Private Sub cmb_withEventsTest_KeyDown(KeyCode As Integer, Shift As Integer)
17'
18End Sub

こうすることで、
クラスのKeyDownイベントが呼出されるようになった。

キーボード入力が不可となった

問題点

しかし、このやり方には問題がある。

上記のcmb_withEventsTest_KeyDown関数は、
空欄のままだと
VBEのデバッグ->コンパイルを実行すると
VBEが不要とみなして自動的に削除してしまう。

そのため、あえてコメント行をはさんで削除されないようにしているが、
コードとしてメンテナンス性に欠ける
（他の人がこのコードを見たときに、不要とみなして削除してしまうかもしれない）。

1Private Sub cmb_withEventsTest_KeyDown(KeyCode As Integer, Shift As Integer)
2'
3End Sub

ii. ComboBoxオブジェクト変数のOnKeyDownプロパティに[Event Procedure]と設定する

参考にしたstackoverflow

stackoverflow中の、

1listener.ct.OnClick = "[Event Procedure]"  '<------- Assigned the event handler

の部分で、おそらくこの文言を追加すれば良いのかと思い、
下記のように、クラスのmyComboBoxのsetterメソッドにおいて
コードに適用してみた。

 1Option Compare Database
 2Option Explicit
 3
 4'**************************
 5'*コンボボックスイベントリスナー
 6'**************************
 7
 8'定数
 9
10'変数
11Private WithEvents myComboBox As Access.ComboBox
12
13'******************************************************************************************
14'*getter/setter
15'******************************************************************************************
16Public Property Set ComboBox(ByRef cmb As Access.ComboBox)
17    Set myComboBox = cmb
18    myComboBox.OnKeyDown = "[Event Procedure]"
19End Property
20
21
22'~~~~~~~~~以下略~~~~~~~~
23

これで想定通りに動くようになった。

comments powered by Disqus

Translations:

"English" |