ユーザーフォーム上の数値入力や日付入力の工夫

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



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

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


'***************************************************************************************************
'   フォーム上の数値、日付の編集サンプル                            UserForm1(Class)
'
'   作成者:井上治  URL:http://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
'* 機能  :日付Aテキストボックスイベント(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
'* 機能  :金額Aテキストボックスイベント(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
'* 機能  :日付Bテキストボックスイベント(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
'* 機能  :金額Bテキストボックスイベント(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」をクラス化してまとめてしまうことを考えているのが、次ページです。