VBA応用(ユーザーフォーム上の数値入力や日付入力の工夫)

ユーザーフォーム上の入力では数字や日付でもテキストボックスを使用します。ワークシートのセルのように書式設定で編集する機能がありませんが、イベント記述で似たようなことを行なうことができます。

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

日付と数値(3桁カンマ編集)の入力支援のサンプルです。

(画像をクリックすると、このサンプルがダウンロードできます)
立ち上げると、このようなユーザーフォームが表示されます。
「日付」項目は項目に入ると月日の前ゼロがなくなり、項目から抜けると元("YYYY/MM/DD")に戻ります。
「金額」項目は項目に入るとカンマがなくなり、項目から抜けると3桁ごとにカンマが付加されます。

日付と数値それぞれ3項目ずつありますが、処理は共通プロシージャに集約しています。
まずはイベント記述部分ですが、日付と数値それぞれ3項目×EnterとExitなので合計12個のプロシージャになります。


'***************************************************************************************************
'   フォーム上の数値、日付の編集サンプル                            UserForm1(Class)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'03/11/16(1.01)初回修正
'20/02/24(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsDate As String = "YYYY/MM/DD"
Private Const g_cnsDateE As String = "YYYY/M/D"

'***************************************************************************************************
'   ■■■ フォームイベント ■■■
'***************************************************************************************************
'* 処理名　：UserForm_Initialize
'* 機能　　：フォーム初期化
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月24日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_Initialize()
    '-----------------------------------------------------------------------------------------------
    ' 初期クリア
    Call GP_ClearForm
End Sub

'***************************************************************************************************
'   ■■■ コントロールイベント ■■■
'***************************************************************************************************
'* 処理名　：TXT_DATE1_Enter、TXT_DATE1_Exit
'* 機能　　：日付①テキストボックスイベント(Enter、Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月24日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TXT_DATE1_Enter()
    '-----------------------------------------------------------------------------------------------
    ' 日付項目入力用編集
    Call GP_DateEnter(TXT_DATE1)
End Sub

Private Sub TXT_DATE1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '-----------------------------------------------------------------------------------------------
    ' 日付項目表示用編集
    Cancel = Not FP_DateExit(TXT_DATE1)
End Sub

'***************************************************************************************************
'* 処理名　：TXT_GAKU1_Enter、TXT_GAKU1_Exit
'* 機能　　：金額①テキストボックスイベント(Enter、Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月24日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TXT_GAKU1_Enter()
    '-----------------------------------------------------------------------------------------------
    ' 金額項目入力用編集
    Call GP_GakuEnter(TXT_GAKU1)
End Sub

Private Sub TXT_GAKU1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '-----------------------------------------------------------------------------------------------
    ' 金額項目表示用編集
    Cancel = Not FP_GakuExit(TXT_GAKU1)
End Sub

'***************************************************************************************************
'* 処理名　：TXT_DATE2_Enter、TXT_DATE2_Exit
'* 機能　　：日付②テキストボックスイベント(Enter、Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月24日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TXT_DATE2_Enter()
    '-----------------------------------------------------------------------------------------------
    ' 日付項目入力用編集
    Call GP_DateEnter(TXT_DATE2)
End Sub

Private Sub TXT_DATE2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '-----------------------------------------------------------------------------------------------
    ' 日付項目表示用編集
    Cancel = Not FP_DateExit(TXT_DATE2)
End Sub

'***************************************************************************************************
'* 処理名　：TXT_GAKU2_Enter、TXT_GAKU2_Exit
'* 機能　　：金額②テキストボックスイベント(Enter、Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月24日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TXT_GAKU2_Enter()
    '-----------------------------------------------------------------------------------------------
    ' 金額項目入力用編集
    Call GP_GakuEnter(TXT_GAKU2)
End Sub

Private Sub TXT_GAKU2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '-----------------------------------------------------------------------------------------------
    ' 金額項目表示用編集
    Cancel = Not FP_GakuExit(TXT_GAKU2)
End Sub

'***************************************************************************************************
'* 処理名　：TXT_DATE3_Enter、TXT_DATE3_Exit
'* 機能　　：日付③テキストボックスイベント(Enter、Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月24日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TXT_DATE3_Enter()
    '-----------------------------------------------------------------------------------------------
    ' 日付項目入力用編集
    Call GP_DateEnter(TXT_DATE3)
End Sub

Private Sub TXT_DATE3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '-----------------------------------------------------------------------------------------------
    ' 日付項目表示用編集
    Cancel = Not FP_DateExit(TXT_DATE3)
End Sub

'***************************************************************************************************
'* 処理名　：TXT_GAKU3_Enter、TXT_GAKU3_Exit
'* 機能　　：金額③テキストボックスイベント(Enter、Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年02月24日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TXT_GAKU3_Enter()
    '-----------------------------------------------------------------------------------------------
    ' 金額項目入力用編集
    Call GP_GakuEnter(TXT_GAKU3)
End Sub

Private Sub TXT_GAKU3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    '-----------------------------------------------------------------------------------------------
    ' 金額項目表示用編集
    Cancel = Not FP_GakuExit(TXT_GAKU3)
End Sub

各テキストボックスの「Enter」「Exit」のイベントプロシージャを記述しますが、ここでは共通プロシージャをコントロール(オブジェクト)を引数にして呼び出すだけです。「Exit」プロシージャでは字類チェックを行なうので、エラー時は項目から抜けないようにCancelを戻り値にしたFunctionプロシージャを呼び出します。 6つのテキストボックス×2イベントなので同じようなプロシージャが12個あります。

では、上記イベントプロシージャから呼ばれる共通プロシージャです。


'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：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 >>----------------------------------------

編集処理はこのように共通プロシージャ化しているので合理化できたといえばそうですが、TextBoxをたくさん並べるような処理では記述が大変です。そこで、「Enter」「Exit」をクラス化してまとめてしまうことを考えているのが、次ページです。