ユーザーフォームのコントロールを配列にする。(クラス処理)

VBAのユーザーフォームはVisualBasicと違い、コントロールを配列にできない欠点があります。
VB.NETで同様のサンプルを作成しました。   「コントロールの配列化サンプル」です。
同じように「日付」「金額」のテキストボックスを3個ずつならべたもので、フォーカスインとフォーカスアウトでの編集動作だけを行なうものです。
最初から6個のテキストボックスをテーブル化させて、それぞれのイベントは共通記述にさせていますので VBA(ユーザーフォーム)との動作や記述の違いなどをぜひご覧下さい。



クラスで処理すると配列として処理し、クラス内で共通にイベント記述させることができます。
これは、昔、MOUGのサイトで大村あつし先生が「スキルアップ講座」で書いておられたサンプルを見て作ったものです。
クラス処理
(画像をクリックすると、このサンプルがダウンロードできます)
クリックイベントをクラスモジュール側でトラップしてしまうものです。私のオリジナリティには欠けるのでここでは詳しい説明は省きます。

クラスの利用は、「API関連」のページでも別な形で登場します。本当はここでテキストボックスをセル書式のように編集する前項の例をクラス処理で実現したかったのですが、テキストボックス(MSForms.TextBox)をクラス化しても「Enter」や「Exit」のイベントはトラップできません。
Click」「KeyDown」「MouseDown」等はトラップできますが、コントロールからのフォーカス脱出が掴めないので片手落ちです。
共通なチェック処理や編集表示を作成するにしても「Exit」イベントで行ないたいですし、こうなるとクラス処理する必然性が半減してしまいます。前項の「数値入力や日付入力の工夫」など同種の入力項目が複数ある時に集約できる方式として期待したのですが正攻法では無理なようです。

ならばと調べた(過去のMLのログなど)のですが、方法は「ない」こともないようです。実行動作は前ページの「数値入力や日付入力の工夫」と同じです。
フォーム上の数値、日付の編集(クラス処理)
(画像をクリックすると、このサンプルがダウンロードできます)
どう処理するのかと言うと、「クラス側でイベントを掴む」のではなく「クラス側でイベントを発生させる」のです。

まず、イベントクラスモジュール(clsExitFocus)のソースコードです。


'***************************************************************************************************
'   フォーム上のコントロールの配列利用のためのクラス                clsExitFocus(Class)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/18(1.00)新規作成
'19/10/24(1.01)*.xlsm化、他
'20/02/24(1.10)記述修正(標準化準拠含む)、オブジェクト最適化
'***************************************************************************************************
Option Explicit
'===================================================================================================
#If VBA7 Then
' ■スリープ(API)
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
#Else
' ■スリープ(API)
Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
#End If
'---------------------------------------------------------------------------------------------------
Private g_strActCont As String                          ' 現在のコントロール名
Private g_blnActCont As Boolean                         ' 現在のコントロールはTextBoxか
Private g_objActCont As MSForms.TextBox                 ' 現在のコントロール(TextBox)
'===================================================================================================
' 発生させるTextBoxのEnter独自イベント
Public Event EnterFocus(lngIx As Long)
' 発生させるTextBoxのExit独自イベント
Public Event ExitFocus(lngIx As Long)

'***************************************************************************************************
'   ■■■ イベント監視 ■■■
'***************************************************************************************************
'* 処理名 :ActConrol
'* 機能  :フォーム上でActiveControlが移動するのを監視
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ユーザーフォーム(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:引数はMsForms.UserFormではダメ!(プロパティにTagがない)
'***************************************************************************************************
Public Sub ActControl(objForm As UserForm1)
    '-----------------------------------------------------------------------------------------------
    ' 実行時エラーでは本ループは強制的に停止
    On Error GoTo ActControl_Exit
    With objForm
        ' このループはUserFormの表示中繰り返す
        Do
            DoEvents
            ' UserFormのTagにてループ中止を判断
            If .Tag = 9 Then Exit Do
            ' コントロールのフォーカスが変わったことの判定
            If .ActiveControl.Name <> g_strActCont Then
                ' 直前のコントロールがTextBoxか
                If g_blnActCont Then
                    ' Exitイベントを発生させる
                    RaiseEvent ExitFocus(CLng(g_objActCont.Tag))
                End If
                ' 現在フォーカスのコントロール名を取得
                g_strActCont = .ActiveControl.Name
                ' 現在フォーカスのコントロールはTextBoxか
                If TypeName(.ActiveControl) = "TextBox" Then
                    ' 現在フォーカスのコントロールを取得
                    g_blnActCont = True
                    Set g_objActCont = .ActiveControl
                    ' Enterイベントを発生させる
                    RaiseEvent EnterFocus(CLng(g_objActCont.Tag))
                Else
                    g_blnActCont = False
                End If
            End If
            ' Sleep(20ms:CPU負荷軽減のため)
            Sleep 20
        Loop
    End With
'===================================================================================================
' 終了(エラートラップ含む)
ActControl_Exit:
    ' Terminateでおそらくエラーとなって抜けている
    On Error GoTo 0
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

このクラスはユーザーフォームの起動時に「WithEvents」で呼び出され、ユーザーフォームが開いている間常駐します。
このクラスには「EnterFocus」「ExitFocus」という独自イベントが用意されています。
ユーザーフォームの「UserForm_Activate」内で「ActControl」プロシージャが呼び出されます。



ActControl」プロシージャ内はユーザーフォームの終了までの無限ループが配置されており、20ms間隔で繰り返します。 ループ内で「ActiveControl」の変更を監視しており、変更があった時にはまず、 以前のTextBoxに対して「ExitFocus」イベントを発生させて、 新しい「ActiveControl」がTextBoxであれば「EnterFocus」を発生させるという動作をするものです。



これでユーザーフォーム側の記述はテキストボックスのコントロールの数に関係なく、一対の「EnterFocus」「ExitFocus」のイベント記述だけで済みます。

それではユーザーフォーム側のソースコードですが、記述順に沿ってまずはモジュール宣言部分とフォームイベントです。

'***************************************************************************************************
'   サンプルユーザーフォーム                                        UserForm1(Class)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/18(1.00)新規作成
'19/10/24(1.01)*.xlsm化、他
'20/02/24(1.10)記述修正(標準化準拠含む)
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsDate As String = "YYYY/MM/DD"
Private Const g_cnsDateE As String = "YYYY/M/D"
'---------------------------------------------------------------------------------------------------
Private WithEvents clsForm As clsExitFocus                          ' 独自クラス
Private g_tblType(5) As Integer                                     ' 動作タイプ(0=日付、1=金額)
Private g_objTextBox(5) As MSForms.TextBox                          ' TextBox

'***************************************************************************************************
'   ■■■ フォームイベント ■■■
'***************************************************************************************************
'* 処理名 :UserForm_Activate
'* 機能  :フォーム初期表示
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Activate()
    '-----------------------------------------------------------------------------------------------
    Me.Tag = 0
    ' clsForm.ActConrolを起動する(停止されるまでループ)
    clsForm.ActControl Me
End Sub

'***************************************************************************************************
'* 処理名 :UserForm_Initialize
'* 機能  :フォーム初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Initialize()
    '-----------------------------------------------------------------------------------------------
    ' 動作タイプ(0=日付、1=金額)の指定
    g_tblType(0) = 0                                        ' TXT_DATE1
    g_tblType(1) = 1                                        ' TXT_GAKU1
    g_tblType(2) = 0                                        ' TXT_DATE2
    g_tblType(3) = 1                                        ' TXT_GAKU2
    g_tblType(4) = 0                                        ' TXT_DATE3
    g_tblType(5) = 1                                        ' TXT_GAKU3
    ' クラスインスタンスを生成
    Set clsForm = New clsExitFocus
    ' テキストボックスを配列として取得しておく
    Set g_objTextBox(0) = TXT_DATE1
    Set g_objTextBox(1) = TXT_GAKU1
    Set g_objTextBox(2) = TXT_DATE2
    Set g_objTextBox(3) = TXT_GAKU2
    Set g_objTextBox(4) = TXT_DATE3
    Set g_objTextBox(5) = TXT_GAKU3
    ' 初期クリア
    Call GP_ClearForm
End Sub

'***************************************************************************************************
'* 処理名 :UserForm_QueryClose
'* 機能  :フォーム閉鎖動作
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    '-----------------------------------------------------------------------------------------------
    ' イベント生成処理を停止指示(Hideする前に必須)
    Me.Tag = 9
End Sub

'***************************************************************************************************
'* 処理名 :UserForm_Terminate
'* 機能  :フォーム閉鎖
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Terminate()
    '-----------------------------------------------------------------------------------------------
    ' クラスインスタンスを廃棄
    Set clsForm = Nothing
End Sub
モジュールレベル保持変数に「WithEvents clsForm」があるのと、 テキストボックスを配列化してモジュールレベルに保持する以外は時に変わったことはしていません。



今回、このような「クドイ」記述になってしまったのは、配列保持したテキストボックスに対して動的に「Enter」「Exit」のイベントがトラップできないというところから始まっています。
そこでこの「Enter」「Exit」を代替するクラスを作成して、そのクラス側から独自イベントを発生させるという処理になっています。
次はその「代替イベント」の部分です。

'***************************************************************************************************
'   ■■■ コントロールイベント ■■■
'***************************************************************************************************
'* 処理名 :clsForm_EnterFocus
'* 機能  :テキストボックスのEnter代替イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = テキストボックスのINDEX(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub clsForm_EnterFocus(lngIx As Long)
    '-----------------------------------------------------------------------------------------------
    ' 金額か
    If g_tblType(lngIx) = 1 Then
        ' 金額項目入力用編集
        Call GP_GakuEnter(g_objTextBox(lngIx))
    Else
        ' 日付項目入力用編集
        Call GP_DateEnter(g_objTextBox(lngIx))
    End If
End Sub

'***************************************************************************************************
'* 処理名 :clsForm_ExitFocus
'* 機能  :テキストボックスのExit代替イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = テキストボックスのINDEX(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub clsForm_ExitFocus(lngIx As Long)
    '-----------------------------------------------------------------------------------------------
    Dim blnRet As Boolean                                           ' 処理結果
    ' 金額か
    If g_tblType(lngIx) = 1 Then
        ' 金額項目表示用編集
        blnRet = FP_GakuExit(g_objTextBox(lngIx))
    Else
        ' 日付項目表示用編集
        blnRet = FP_DateExit(g_objTextBox(lngIx))
    End If
    ' エラー時はフォーカスを戻す(ここは配列処理不可?)
    If Not blnRet Then
        Select Case lngIx
            Case 0: TXT_DATE1.SetFocus
            Case 1: TXT_GAKU1.SetFocus
            Case 2: TXT_DATE2.SetFocus
            Case 3: TXT_GAKU2.SetFocus
            Case 4: TXT_DATE3.SetFocus
            Case 5: TXT_GAKU3.SetFocus
        End Select
    End If
End Sub

'***************************************************************************************************
'* 処理名 :CMD_OK_Click
'* 機能  :「OK」ボタンClickイベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月18日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub CMD_OK_Click()
    '-----------------------------------------------------------------------------------------------
    ' イベント生成処理を停止指示(Hideする前に必須)
    Me.Tag = 9
    ' フォームを非表示にする
    Me.Hide
    MsgBox TXT_DATE1.Text & vbCr & _
           TXT_GAKU1.Text & vbCr & _
           TXT_DATE2.Text & vbCr & _
           TXT_GAKU2.Text & vbCr & _
           TXT_DATE3.Text & vbCr & _
           TXT_GAKU3.Text
End Sub
clsForm_EnterFocus」が先頭で説明したイベントクラスの「Public Event EnterFocus」によるもので、 同イベントクラス内の「ActControl」プロシージャのループ中にある「RaiseEvent EnterFocus」で呼び出されます。
clsForm_ExitFocus」も同様の説明になります。
この時「どのテキストボックスか」は引数でインデックスが渡されてくるので、これで判断すれば良いわけです。



後は共通のサブ処理ですが、内容は前ページと同じです。

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :GP_ClearForm
'* 機能  :フォームクリア
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_ClearForm()
    '-----------------------------------------------------------------------------------------------
    Dim strDate As String                                           ' 日付編集値
    Dim strGaku As String                                           ' 金額編集値
    strDate = Format(Date, g_cnsDate)
    strGaku = "0"
    ' 各テキストボックスに初期値をセット
    TXT_DATE1.Text = strDate
    TXT_GAKU1.Text = strGaku
    TXT_DATE2.Text = strDate
    TXT_GAKU2.Text = strGaku
    TXT_DATE3.Text = strDate
    TXT_GAKU3.Text = strGaku
End Sub

'***************************************************************************************************
'* 処理名 :GP_DateEnter
'* 機能  :日付項目入力用編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = テキストボックス(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_DateEnter(objTextBox As MSForms.TextBox)
    '-----------------------------------------------------------------------------------------------
    Dim strDate As String                                           ' 入力テキスト
    Dim dteDate As Date                                             ' 日付値
    strDate = Trim(objTextBox.Text)
    ' 日付なら月日の前ゼロを取る
    If IsDate(strDate) Then
        dteDate = CDate(strDate)
        objTextBox.Text = Format(dteDate, g_cnsDateE)
        ' 全桁選択
        Call GP_AllSelect(objTextBox)
    End If
End Sub

'***************************************************************************************************
'* 処理名 :FP_DateExit
'* 機能  :日付項目表示用編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :チェック成否(Boolean)
'* 引数  :Arg1 = テキストボックス(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_DateExit(objTextBox As MSForms.TextBox) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim strDate As String                                           ' 入力テキスト
    Dim dteDate As Date                                             ' 日付値
    FP_DateExit = False
    strDate = Trim(objTextBox.Text)
    ' 日付なら再編集
    If IsDate(strDate) Then
        dteDate = CDate(strDate)
        objTextBox.Text = Format(dteDate, g_cnsDate)
        FP_DateExit = True
    Else
        MsgBox "日付ではありません。", vbExclamation
        ' 全桁選択
        Call GP_AllSelect(objTextBox)
    End If
End Function

'***************************************************************************************************
'* 処理名 :GP_GakuEnter
'* 機能  :金額項目入力用編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = テキストボックス(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_GakuEnter(objTextBox As MSForms.TextBox)
    '-----------------------------------------------------------------------------------------------
    Dim strGaku As String                                           ' 入力テキスト
    Dim crnGaku As Currency                                         ' 金額値
    strGaku = Trim(objTextBox.Text)
    ' 数値か
    If IsNumeric(strGaku) Then
        crnGaku = CCur(strGaku)
        ' 3桁カンマ除去で編集
        objTextBox.Text = Format(crnGaku, "0")
        ' 全桁選択
        Call GP_AllSelect(objTextBox)
    End If
End Sub

'***************************************************************************************************
'* 処理名 :FP_GakuExit
'* 機能  :金額項目表示用編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :チェック成否(Boolean)
'* 引数  :Arg1 = テキストボックス(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_GakuExit(objTextBox As MSForms.TextBox) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim strGaku As String                                           ' 入力テキスト
    Dim crnGaku As Currency                                         ' 金額値
    FP_GakuExit = False
    strGaku = Trim(objTextBox.Text)
    ' 数値か
    If IsNumeric(strGaku) Then
        crnGaku = CCur(strGaku)
        ' 3桁カンマ付きで編集
        objTextBox.Text = Format(crnGaku, "#,##0")
        FP_GakuExit = True
    Else
        MsgBox "数字ではありません。", vbExclamation
        ' 全桁選択
        Call GP_AllSelect(objTextBox)
    End If
End Function

'***************************************************************************************************
'* 処理名 :GP_AllSelect
'* 機能  :全桁選択
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = テキストボックス(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月24日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_AllSelect(objTextBox As MSForms.TextBox)
    '-----------------------------------------------------------------------------------------------
    With objTextBox
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

'----------------------------------------<< End of Source >>----------------------------------------