Numeric Textbox with a Fixed Decimal Place – Like a Calculator
This is code I wrote for a TextBox that only accepts numeric entries. Numbers are entered from right to left with a fixed two place decimal. It’s like a calculator where input follows the format: .01, .12, 1.23, 12.34, etc. The decimal is automatically entered and can be replaced with a “:” for Time TextBoxes. All numbers are entered and removed from the right side. Numbers are removed with the Delete Key or the Backspace. This code uses the KeyDown Event, so copying and pasting into the TextBox is disabled.
Code:
Public Class Form1
'
' Modified 1/6/10 to include support for numberpad
Dim d As Integer ' index of decimal or colon
Dim theText As String ' String that calculates the new texbox value
Dim theNum As String ' The Number that was entered - Either from the keyboard or the numberpad
Dim numSep As String = "." ' Selected seperator - Can be . or :
'
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' Set total length and right alignment of TextBox and Disable Copy/Paste
TextBox1.TextAlign = HorizontalAlignment.Right
TextBox1.MaxLength = 5
TextBox1.ShortcutsEnabled = False ' Disable Right-Click Context Menu - No Pasting Allowed - Ctrl-V disabled because V is invalid
End Sub
Private Sub TextBox1_Keydown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown
' Textbox will accept numbers only in the format 20.45 or 20:45 - Seperator is automaically entered
' Set MaxLength Property to control length
' All numbers are entered from right to left
' Use Back Space or Del Key to remove numbers starting from right side
' Right now only supports 2 decimal places
' Paste is disabled - pasting text into textbox would crash app
'
theText = String.Empty
'
If (((e.KeyData >= 48 And e.KeyData <= 57) Or (e.KeyCode >= Keys.NumPad0 And e.KeyCode <= Keys.NumPad9)) And Len(TextBox1.Text) < TextBox1.MaxLength) Or e.KeyData = Keys.Back Or e.KeyData = Keys.Delete Then
'
If e.KeyData <> Keys.Back And e.KeyData <> Keys.Delete Then
'
If e.KeyData >= 48 And e.KeyData <= 57 Then
' Keyboard Number Entry
theNum = Chr(e.KeyData)
Else
' Keyboard NumberPad Entry
theNum = Microsoft.VisualBasic.Right(e.KeyData.ToString, 1)
End If
'
TextBox1.Text = TextBox1.Text & theNum
'
If Len(TextBox1.Text) >= 2 Then
If Len(TextBox1.Text) = 2 Then ' Apply the seperator
TextBox1.Text = numSep & TextBox1.Text
Else
' Append new number to right and shift everything to the left
d = TextBox1.Text.IndexOf(numSep)
theText = Microsoft.VisualBasic.Left(TextBox1.Text, d) & TextBox1.Text.Substring(d + 1, 1) & numSep & TextBox1.Text.Substring(d + 2, 1) & theNum
'
If Microsoft.VisualBasic.Left(theText, 1) = "0" Then
' Remove leading '0' if going from .01 to .12 - don't want 0.12
theText = theText.Remove(0, 1)
End If
'
TextBox1.Text = theText
'
End If
End If
'
Else
' Remove far right number and shift everything to the right
If Len(TextBox1.Text) > 3 Then
d = TextBox1.Text.IndexOf(numSep)
theText = Microsoft.VisualBasic.Left(TextBox1.Text, d - 1) & numSep & TextBox1.Text.Substring(d - 1, 1) & TextBox1.Text.Substring(d + 1, 1)
Else
If Len(TextBox1.Text) = 3 Then
theText = TextBox1.Text.Substring(1, 1)
Else
theText = String.Empty
End If
End If
'
TextBox1.Text = theText
'
End If
'
End If
'
' Always suppress the key pressed, if key entered was valid - this event handles it - otherwise suppress it
e.SuppressKeyPress = True
''
End Sub
' When leaving the textbox, if the length is 1 pad with a 0 or clear it if the value is 0 or 00
Private Sub TextBox1_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.Leave
'
If Len(TextBox1.Text) = 1 Then
If TextBox1.Text <> "0" Then
TextBox1.Text = numSep & "0" & TextBox1.Text
Else
TextBox1.Text = String.Empty
End If
End If
'
If Len(TextBox1.Text) = 3 And TextBox1.Text = numSep & "00" Then
TextBox1.Text = String.Empty
End If
End Sub
End Class
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
Im getting errors when I add this to VBA in Excel 2007 SP2.
Where exactly should I enter this code?
Very interested! :)
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
This one is meant for VB.NET
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
Quote:
Originally Posted by
Pradeep1210
This one is meant for VB.NET
This is exactly what I need.
Can it be converted to VBA for Excel 2007?
Would it be possible?
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
The logic would be same and most of the statements too.
Just go line by line and convert it to equivalent VBA code.
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
This is the equivalent. ( I'm not sure though if it works same or not)
Code:
Option Explicit
Dim d As Integer ' index of decimal or colon
Dim theText As String ' String that calculates the new textbox value
Const numSep As String = "." ' Selected seperator - Can be . or :
Private Sub UserForm_Initialize()
' Set total length and right alignment of TextBox and Disable Copy/Paste
TextBox1.TextAlign = fmTextAlignRight
TextBox1.MaxLength = 5
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Textbox will accept numbers only in the format 20.45 or 20:45 - Seperator is automaically entered
' Set MaxLength Property to control length
' All numbers are entered from right to left
' Use Back Space or Del Key to remove numbers starting from right side
' Right now only supports 2 decimal places
' Paste is disabled - pasting text into textbox would crash app
'
theText = ""
'
If (KeyCode >= 48 And KeyCode <= 57 And Len(TextBox1.Text) < TextBox1.MaxLength) Or KeyCode = vbKeyBack Or KeyCode = vbKeyDelete Then
'
If KeyCode <> vbKeyBack And KeyCode <> vbKeyDelete Then
'
TextBox1.Text = TextBox1.Text & Chr(KeyCode)
'
If Len(TextBox1.Text) >= 2 Then
If Len(TextBox1.Text) = 2 Then ' Apply the seperator
TextBox1.Text = numSep & TextBox1.Text
Else
' Append new number to right and shift everything to the left
d = InStr(TextBox1.Text, numSep)
theText = Left(TextBox1.Text, d) & Mid(TextBox1.Text, d + 1, 1) & numSep & Mid(TextBox1.Text, d + 2, 1) & Chr(KeyCode)
'
If Left(theText, 1) = "0" Then
' Remove leading '0' if going from .01 to .12 - don't want 0.12
theText = Mid(theText, 1)
End If
'
TextBox1.Text = theText
'
End If
End If
'
Else
' Remove far right number and shift everything to the right
If Len(TextBox1.Text) > 3 Then
d = InStr(TextBox1.Text, numSep)
theText = Left(TextBox1.Text, d - 1) & numSep & Mid(TextBox1.Text, d - 1, 1) & Mid(TextBox1.Text, d + 1, 1)
Else
If Len(TextBox1.Text) = 3 Then
theText = Mid(TextBox1.Text, 1, 1)
Else
theText = ""
End If
End If
'
TextBox1.Text = theText
'
End If
'
End If
'
' Always suppress the key pressed, if key entered was valid - this event handles it - otherwise suppress it
KeyCode = 0
End Sub
' When leaving the textbox, if the length is 1 pad with a 0 or clear it if the value is 0 or 00
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'
If Len(TextBox1.Text) = 1 Then
If TextBox1.Text <> "0" Then
TextBox1.Text = numSep & "0" & TextBox1.Text
Else
TextBox1.Text = ""
End If
End If
'
If Len(TextBox1.Text) = 3 And TextBox1.Text = numSep & "00" Then
TextBox1.Text = ""
End If
End Sub
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
Thanks for taking the time to help.
I've tried the code you've provided But all that happens in the TextBox is a blinking cursor that is aligned to the right.
I can't enter anything in it though.
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
That OP (dkhan) may be able to answer. I'm not even sure why so much effort has been made to implement such a simple functionality. I might be missing the point completely though :)
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
I just noticed that I can enter Only numbers on my keyboard with your code, Not with my NumberPad though.
But it still won't do what it is supposed to. Hopefully the OP can shed some light on this.
Thanks for taking the time though :)
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
ok try like this:
(insert the highlighted lines in red)
Code:
Option Explicit
Dim d As Integer ' index of decimal or colon
Dim theText As String ' String that calculates the new textbox value
Const numSep As String = "." ' Selected seperator - Can be . or :
Private Sub UserForm_Initialize()
' Set total length and right alignment of TextBox and Disable Copy/Paste
TextBox1.TextAlign = fmTextAlignRight
TextBox1.MaxLength = 5
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Textbox will accept numbers only in the format 20.45 or 20:45 - Seperator is automaically entered
' Set MaxLength Property to control length
' All numbers are entered from right to left
' Use Back Space or Del Key to remove numbers starting from right side
' Right now only supports 2 decimal places
' Paste is disabled - pasting text into textbox would crash app
'
If KeyCode >= vbKeyNumpad0 And KeyCode <= vbKeyNumpad9 Then
KeyCode = KeyCode - vbKeyNumpad0 + 48
End If
theText = ""
'
If (KeyCode >= 48 And KeyCode <= 57 And Len(TextBox1.Text) < TextBox1.MaxLength) Or KeyCode = vbKeyBack Or KeyCode = vbKeyDelete Then
'
If KeyCode <> vbKeyBack And KeyCode <> vbKeyDelete Then
'
TextBox1.Text = TextBox1.Text & Chr(KeyCode)
'
If Len(TextBox1.Text) >= 2 Then
If Len(TextBox1.Text) = 2 Then ' Apply the seperator
TextBox1.Text = numSep & TextBox1.Text
Else
' Append new number to right and shift everything to the left
d = InStr(TextBox1.Text, numSep)
theText = Left(TextBox1.Text, d) & Mid(TextBox1.Text, d + 1, 1) & numSep & Mid(TextBox1.Text, d + 2, 1) & Chr(KeyCode)
'
If Left(theText, 1) = "0" Then
' Remove leading '0' if going from .01 to .12 - don't want 0.12
theText = Mid(theText, 1)
End If
'
TextBox1.Text = theText
'
End If
End If
'
Else
' Remove far right number and shift everything to the right
If Len(TextBox1.Text) > 3 Then
d = InStr(TextBox1.Text, numSep)
theText = Left(TextBox1.Text, d - 1) & numSep & Mid(TextBox1.Text, d - 1, 1) & Mid(TextBox1.Text, d + 1, 1)
Else
If Len(TextBox1.Text) = 3 Then
theText = Mid(TextBox1.Text, 1, 1)
Else
theText = ""
End If
End If
'
TextBox1.Text = theText
'
End If
'
End If
'
' Always suppress the key pressed, if key entered was valid - this event handles it - otherwise suppress it
KeyCode = 0
End Sub
' When leaving the textbox, if the length is 1 pad with a 0 or clear it if the value is 0 or 00
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'
If Len(TextBox1.Text) = 1 Then
If TextBox1.Text <> "0" Then
TextBox1.Text = numSep & "0" & TextBox1.Text
Else
TextBox1.Text = ""
End If
End If
'
If Len(TextBox1.Text) = 3 And TextBox1.Text = numSep & "00" Then
TextBox1.Text = ""
End If
End Sub
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
I tried the modification you've supplied & I get the same result as before.
I'll try what you have just suggested.
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
Okay, we've gained a lot of progress.
It's mostly working now with a few issues.
The seperator/Decimal Places are not being added:
Quote:
Textbox will accept numbers only in the format 20.45 or 20:45 - Seperator is automaically entered
Right now only supports 2 decimal places
Backspace & Delete are not working. When I use them I get error & when I debug it highlights this line:
Quote:
theText = Left(TextBox1.Text, d - 1) & numSep & Mid(TextBox1.Text, d - 1, 1) & Mid(TextBox1.Text, d + 1, 1)
Everything else seems to be working though. ;)
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
From what it seems to me, this should be more than enough for you:
Code:
Option Explicit
Const numSep As String = "." ' Selected seperator - Can be . or :
Private Sub UserForm_Initialize()
TextBox1.TextAlign = fmTextAlignRight
TextBox1.MaxLength = 5
End Sub
Private Sub TextBox1_Change()
If Not IsNumeric(TextBox1.Text) Then TextBox1.Text = "0"
Dim theText As String
theText = Val(Replace(TextBox1.Text, numSep, ""))
If Len(theText) >= 2 Then
theText = Left(theText, Len(theText) - 2) & numSep & Format(Right(theText, 2), "00")
Else
theText = numSep & Format(Right(theText, 2), "00")
End If
TextBox1.Text = theText
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case vbKey0 To vbKey9, vbKeyNumpad0 To vbKeyNumpad9, vbKeyBack, vbKeyDelete 'allowed keys.
Case Else
KeyCode = 0
End Select
End Sub
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
So very close...:)
Only 1 problem!
It doesn't automatically insert the decimal point. (Seperator)
Example:
1234 should read 12.34
Everything else seems to work just perfect.
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
Did you try what was in post #13. It works for me correctly. i.e. Puts the decimal place fixed at 2 place from right.
So when I type 1234, I actually get 12.34
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
This is how it changes when I type in the textbox:
Code:
1 --> .01
2 --> .12
3 --> 1.23
4 --> 12.34
Re: Numeric Textbox with a Fixed Decimal Place – Like a Calculator
Thanks for helping him Pradeep1210. I wrote this for vb.net and I've never used VBA in Excel 2007, so I'm not sure I could tell you how to convert it.
