【備忘録】Excel VBAのテキストボックスで数値入力範囲を設ける

ExcelのVBAでテキストボックスに数値の入力範囲を設けるモジュール

• 各テキストボックスの「KeyPress」イベントに、「数値」、「－」、「．」以外入力出来なくする。また、「－」は先頭のみ許可し、「．」は１個のみ許可する。
  テキストボックスが、空欄や「－」、「．」、「－．」の時は、「０」として扱う。
  　　　
• 各テキストボックスの「Exit」イベントに、最小値と最大値を設定し、範囲外だと、「Exit」出来なくし、最小値より小さい値の時は、最小値に、最大値より大きい値の時は、最大値を設定する。
  　　　　　

※UserForm1に、TextBox1、TextBox2、TextBox3　を貼り付け、IMEModeを「fmIMEModeDisable」に設定し、半角文字しか入力出来なくする。

【UserForm1内のコード】

Option Explicit

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox_Exit 1, Cancel, 0.25, 25
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBox_KeyPress 1, KeyAscii
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox_Exit 2, Cancel, -15, 15.7
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBox_KeyPress 2, KeyAscii
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox_Exit 3, Cancel, -5.6, 10.5
End Sub

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBox_KeyPress 3, KeyAscii
End Sub

【標準モジュールModule1内のコード】

Option Explicit

Sub TextBox_KeyPress(BoxNum As Integer, KeyAscii As MSForms.ReturnInteger)

Dim C As String

C = UserForm1.Controls("TextBox" & BoxNum).Text

'はてなブログでは、下の条件式の一番外の( )の表示が変になるので、( )を[ ]にしている。
If Not [(KeyAscii > 47 And KeyAscii < 58) Or _
        (KeyAscii = 46 And InStr(C, ".") = 0) Or _
        (KeyAscii = 45 And InStr(C, "-") = 0 And UserForm1.Controls("TextBox" & BoxNum).SelStart = 0)] Then
    KeyAscii = 0
End If

End Sub

Sub TextBox_Exit(BoxNum As Integer, Cancel As MSForms.ReturnBoolean, MinVal As Single, MaxVal As Single)

Dim C As String, T As String

C = UserForm1.Controls("TextBox" & BoxNum).Text
T = C

If C = "" Or C = "-" Or C = "." Then

    T = "0"

ElseIf Left(C, 2) = "-." Then
    T = IIf(C = "-.", "0", "-0." & Right(C, Len(C) - 2))

ElseIf InStr(C, ".") = 1 Then
    T = "0" & C

End If

If T <> C Then UserForm1.Controls("TextBox" & BoxNum).Text = T

If T < MinVal Then

    MsgBox MinVal & " ≦ 設定値 ≦ " & MaxVal & " の範囲で入力して下さい。", , "範囲外"
    UserForm1.Controls("TextBox" & BoxNum).Text = MinVal
    Cancel = True
ElseIf T > MaxVal Then

    MsgBox MinVal & " ≦ 設定値 ≦ " & MaxVal & " の範囲で入力して下さい。", , "範囲外"
    UserForm1.Controls("TextBox" & BoxNum).Text = MaxVal
    Cancel = True

End If

End Sub