From Harald Staff:
Harald Staff
Textbox - numeric validation
Ok, from the top:
New Excel file.
Add a Userform1 containing Textbox1 and Textbox2.
Add a class module (Insert menu). Name the class "NumTxt" in the properties
window.
Paste this into the class module:
'**************************
Option Explicit
Public WithEvents TextBox As MSForms.TextBox
Public tbValue As Double
Public LDecimals As Long
Public Negatives As Boolean
Public DecSep As String
Private Sub Class_Initialize()
Me.DecSep = Mid$(Format(1.5, "0.0"), 2, 1)
Me.Negatives = True
End Sub
Public Sub EnterMe()
With TextBox
.SelStart = 0
.SelLength = Len(.Text)
.BackColor = RGB(255, 255, 170)
End With
End Sub
Private Sub TextBox_KeyDown(ByVal KeyCode As _
MSForms.ReturnInteger, ByVal Shift As Integer)
Dim Btmp As Boolean
If KeyCode = 86 And Shift = 2 Then
KeyCode = 0
TextBox.SelText = ""
Btmp = CBool(Me.LDecimals)
If InStr(TextBox.Text, DecSep) > 0 Then Btmp = False
Debug.Print TextBox.Text, InStr(TextBox.Text, DecSep)
TextBox.SelText = PastedText(Btmp)
End If
End Sub
Private Function PastedText(ByVal AllowDecSep As Boolean) As String
Dim MyDataObj As New DataObject
Dim Stmp As String
Dim D As Double
Dim L As Long
MyDataObj.GetFromClipboard
Stmp = Trim$(MyDataObj.GetText)
Debug.Print AllowDecSep, Stmp
For L = 1 To Len(Stmp)
Select Case Asc(Mid$(Stmp, L))
Case 44, 46
If AllowDecSep Then
PastedText = PastedText & DecSep
AllowDecSep = False
End If
Case 45
If Me.Negatives And TextBox.SelStart = 0 And _
(Len(PastedText) = 0) Then _
PastedText = "-"
Case 48 To 57 'numbers
PastedText = PastedText & Mid$(Stmp, L, 1)
Case Else
End Select
Next
On Error Resume Next
D = CDbl(PastedText)
If D <> 0 Then
PastedText = CStr(D)
Else
PastedText = ""
End If
Debug.Print PastedText
Debug.Print
End Function
Private Sub TextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 8 To 10, 13, 27 'Control characters
Case 44, 46
If Me.LDecimals > 0 And InStr(TextBox.Text, DecSep) = 0 Then
KeyAscii = Asc(DecSep)
Else
Beep
KeyAscii = 0
End If
Case 45
If Me.Negatives And TextBox.SelStart = 0 Then
Else
Beep
KeyAscii = 0
End If
Case 48 To 57 'numbers
Case Else 'Discard anything else
Beep
KeyAscii = 0
End Select
End Sub
Private Sub TextBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal
Shift As Integer)
On Error Resume Next
If IsError(CDbl(Me.TextBox.Text)) Then
Me.tbValue = 0
ElseIf CDbl(Me.TextBox.Text) = 0 Then
Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
Call UserForm1.CalculateMe
End Sub
Public Sub ExitMe()
TextBox.BackColor = vbWhite
On Error Resume Next
If IsError(CDbl(Me.TextBox.Text)) Then
Me.tbValue = 0
'ElseIf Trim$(TextBox.Text) = "" Then
' Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
TextBox.Text = Decorated(Me.tbValue, Me.LDecimals)
End Sub
Public Sub EmptyMe()
Me.TextBox.Text = ""
Call ExitMe
End Sub
Private Function Decorated(DNumber As Double, Optional LDecimals As Long) As
String
Dim sDes As String
If LDecimals > 0 Then
sDes = "." & String(LDecimals, "0")
Else
sDes = ""
End If
Decorated = Format(DNumber, "# ### ### ##0" & sDes)
Decorated = Trim$(Decorated)
End Function
'**************************************
Now back to the userform. Paste this into its module:
'**************************************
Option Explicit
Dim Num1 As New NumTxt
Dim Num2 As New NumTxt
Private Sub UserForm_Initialize()
Set Num1.TextBox = Me.TextBox1
Num1.LDecimals = 2 'decimals allowed, display two
Set Num2.TextBox = Me.TextBox2
Num2.Negatives = False 'no negative numbers, no decimals
End Sub
Private Sub TextBox1_Enter()
Call Num1.EnterMe
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call Num1.ExitMe
End Sub
Private Sub TextBox2_Enter()
Call Num2.EnterMe
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call Num2.ExitMe
End Sub
Public Sub CalculateMe()
Me.Caption = "Product: " & Num1.tbValue * Num2.tbValue
End Sub
'**************************************
Now run it. Enter stuff, paste stuff with Ctrl V, watch things happen when
you type and when you tab between the boxes.
