Text box with 3digit grouping and also support decimal after point.

[Hamidreza777]

Hi dears
I need a text box that can support 3digit grouping while typing ,also can support decimal after point and dont need to grouping after point (.) decimal digits .
Exactly same as xp calculator text box.

For example : 234664343.44 should be 234,664,343.44

Or
23554.5667 should be 23,554.5667
And only one point can type by user.
If any one can help me, please.

[Arnoutdv]

What needs to happen if the user just inputs 12345?
Is the number inputted always in the range of 100,000,000.00 and 999,999,999.99?

I would normally do this in the Validate() event.
If the number is correct show it with Text1.Text = Format(234664343.44,"#,#0.0")

Option Explicit

Private Sub Form_Load()
  Text1.Text = ""
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
    Case 46                      ' .
    Case 48 To 57                ' 0123456789
    Case Else: KeyAscii = 0      ' other
  End Select
End Sub

Private Function IsDouble(ByVal sValue As String, ByRef dValue As Double) As Boolean
  On Error GoTo errHandler
  dValue = CDbl(sValue)
  IsDouble = True
errHandler:
End Function

Private Sub Text1_Validate(Cancel As Boolean)
  Dim sValue As String
  Dim dValue As Double
  
  sValue = Text1.Text
  If IsDouble(sValue, dValue) Then
    Text1.Text = Format(dValue, "#,#0.00")
    Text1.ForeColor = Me.ForeColor
  Else
    Text1.ForeColor = vbRed
  End If
End Sub

[ChrisE]

Hi,

this is the routine I use for Currency, pretty much the same as Arnoutdv

Option Explicit

Private Sub Form_Load()

      Text1.text = "234664343.44"
      Text2.text = ""
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)

      KeyAscii = Currency_KeyPress("", KeyAscii)
End Sub

Private Sub Text1_Validate(Cancel As Boolean)

      If Not Currency_Input_OK(Text1, 2) Then
         MsgBox "Eingabefehler"
         Cancel = True
      End If
End Sub
Public Function Currency_KeyPress(text As String, KeyAscii As Integer) As Integer
'prüft auf numerische Eingaben für Währung

   Static Komma As String
   Static Trenner As String
   
      If Len(Komma) = 0 Then
         If Mid(Format(0, "0.0"), 2, 1) = "," Then
            Komma = ","
            Trenner = "."
         Else
            Komma = "."
            Trenner = ","
         End If
      End If
      
      Currency_KeyPress = KeyAscii           'vorladen
      Select Case KeyAscii
         Case Asc("0") To Asc("9")           'Zahlen zugelassen
         Case 8                              'BackSlash zugelassen
         Case Asc(Komma)                     'Dezimalpunkt zugelassen
            If InStr(1, text, Komma) > 0 Then
               Currency_KeyPress = 0
            End If
         Case Asc(Trenner)                   'Tausendertrennzeichen
         Case 13:
            Currency_KeyPress = 0
            Sendkeys "{Tab}"                 'bei Enter Tab auslösen
         Case Else
            Currency_KeyPress = 0            'ungültige Eingabe
      End Select
End Function

Public Function Currency_Input_OK(TBox As TextBox, _
                                  Optional NumDigitsAfterDec As Long = -1, _
                                  Optional sCurrency As String = "System") As Boolean
                                  
   Static Komma As String
   Static Trenner As String
   Dim s As String
   Dim i As Long
   Dim j As Long
   
      If Len(TBox.text) = 0 Then
         Currency_Input_OK = True
         Exit Function
      End If
   
      'Kommazeichen ermitteln
      If Len(Komma) = 0 Then
         If Mid(Format(0, "0.0"), 2, 1) = "," Then
            Komma = ","
            Trenner = "."
         Else
            Komma = "."
            Trenner = ","
         End If
      End If
                                  
      s = TBox.text
      s = Replace(s, Trenner, "")
      
      'Währung entfernen
      i = InStrRev(s, Space(1))
      If i > 0 Then
         s = Left(s, i - 1)
      End If
      
      'Prüfen auf Nachkommastellen
      i = InStr(1, s, Komma)
      If i > 0 Then
         j = NumDigitsAfterDec
         If j = -1 Then
            j = Len(FormatNumber(0)) - 2
         End If
         If (Len(s) - i) > j Then
            'zuviele Nachkommastellen
            Exit Function
         End If
      End If
      
      'formatieren
      If sCurrency = "System" Then
         s = FormatCurrency(s, NumDigitsAfterDec)
      Else
         s = FormatNumber(s) & LTrim(" " & sCurrency)
      End If

      TBox.text = s
      Currency_Input_OK = True
End Function

Public Sub Sendkeys(text As Variant, Optional wait As Boolean = False)
   Dim WshShell As Object
   Set WshShell = CreateObject("wscript.shell")
   WshShell.Sendkeys CStr(text), wait
   Set WshShell = Nothing
End Sub

HTH

[Hamidreza777]

What needs to happen if the user just inputs 12345?

[/code]

12345 => 12,345
action should be exactly same as windows calculator .
important ,shouldnt accept enter 2 time point sign.


about range of input. no may be sometimes be without any decimal value and only integer valu.

i uploaded a sample video for reference what i want here:

http://s000.tinyupload.com/?file_id=...39127664841537

[Zvoni]

In a case like this (reminds me of the way you enter amounts of money in a transfer-order when online-banking):
Right-align the Textbox
Use this Textbox's KeyPress-Event to filter out everything except digits, delete and backspace
Use the Change or Validate-Event to immediatly reformat the Input to Format(MyText/100, "#,#0.00")

That way it's kind of like entering the amount in units of cents

[Hamidreza777]

Hi,

this is the routine I use for Currency, pretty much the same as Arnoutdv

Option Explicit

Private Sub Form_Load()

      Text1.text = "234664343.44"
      Text2.text = ""
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)

      KeyAscii = Currency_KeyPress("", KeyAscii)
End Sub

Private Sub Text1_Validate(Cancel As Boolean)

      If Not Currency_Input_OK(Text1, 2) Then
         MsgBox "Eingabefehler"
         Cancel = True
      End If
End Sub
Public Function Currency_KeyPress(text As String, KeyAscii As Integer) As Integer
'prüft auf numerische Eingaben für Währung

   Static Komma As String
   Static Trenner As String
   
      If Len(Komma) = 0 Then
         If Mid(Format(0, "0.0"), 2, 1) = "," Then
            Komma = ","
            Trenner = "."
         Else
            Komma = "."
            Trenner = ","
         End If
      End If
      
      Currency_KeyPress = KeyAscii           'vorladen
      Select Case KeyAscii
         Case Asc("0") To Asc("9")           'Zahlen zugelassen
         Case 8                              'BackSlash zugelassen
         Case Asc(Komma)                     'Dezimalpunkt zugelassen
            If InStr(1, text, Komma) > 0 Then
               Currency_KeyPress = 0
            End If
         Case Asc(Trenner)                   'Tausendertrennzeichen
         Case 13:
            Currency_KeyPress = 0
            Sendkeys "{Tab}"                 'bei Enter Tab auslösen
         Case Else
            Currency_KeyPress = 0            'ungültige Eingabe
      End Select
End Function

Public Function Currency_Input_OK(TBox As TextBox, _
                                  Optional NumDigitsAfterDec As Long = -1, _
                                  Optional sCurrency As String = "System") As Boolean
                                  
   Static Komma As String
   Static Trenner As String
   Dim s As String
   Dim i As Long
   Dim j As Long
   
      If Len(TBox.text) = 0 Then
         Currency_Input_OK = True
         Exit Function
      End If
   
      'Kommazeichen ermitteln
      If Len(Komma) = 0 Then
         If Mid(Format(0, "0.0"), 2, 1) = "," Then
            Komma = ","
            Trenner = "."
         Else
            Komma = "."
            Trenner = ","
         End If
      End If
                                  
      s = TBox.text
      s = Replace(s, Trenner, "")
      
      'Währung entfernen
      i = InStrRev(s, Space(1))
      If i > 0 Then
         s = Left(s, i - 1)
      End If
      
      'Prüfen auf Nachkommastellen
      i = InStr(1, s, Komma)
      If i > 0 Then
         j = NumDigitsAfterDec
         If j = -1 Then
            j = Len(FormatNumber(0)) - 2
         End If
         If (Len(s) - i) > j Then
            'zuviele Nachkommastellen
            Exit Function
         End If
      End If
      
      'formatieren
      If sCurrency = "System" Then
         s = FormatCurrency(s, NumDigitsAfterDec)
      Else
         s = FormatNumber(s) & LTrim(" " & sCurrency)
      End If

      TBox.text = s
      Currency_Input_OK = True
End Function

Public Sub Sendkeys(text As Variant, Optional wait As Boolean = False)
   Dim WshShell As Object
   Set WshShell = CreateObject("wscript.shell")
   WshShell.Sendkeys CStr(text), wait
   Set WshShell = Nothing
End Sub

HTH

this code does not work same as i want textbox.
i want to work while typing in text box

[ChrisE]

this code does not work same as i want textbox.
i want to work while typing in text box

that would drive the Financedept. crazy
but that's up to you

[Arnoutdv]

Instead of a TextBox you can also use a Label.
In this sample I used 2 labels and I've set the KeyPreview of the Form to True

lblDisplay for the display of formatted and validated input
lblDebug for the display of the actual input string

Option Explicit

Private m_sValue As String
Private m_sDecimalSign As String
Private m_bDecimalSign As Boolean

Private Sub Form_Load()
  m_sDecimalSign = Mid$(Format(3.1, "0.0"), 2, 1)
  Me.KeyPreview = True
  lblDisplay.Caption = ""
  lblDisplay.Alignment = vbRightJustify
  lblDebug.Caption = ""
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
    Case 46:        AddDecimalSign
    Case 48 To 57:  AddNumericValue KeyAscii
    Case 8:         RemoveCharacter
  End Select
End Sub

Private Sub AddNumericValue(KeyAscii As Integer)
  m_sValue = m_sValue & Chr$(KeyAscii)
  DisplayValue m_sValue
End Sub

Private Sub AddDecimalSign()
  If Not m_bDecimalSign Then
    m_sValue = m_sValue & m_sDecimalSign
    DisplayValue m_sValue
  End If
End Sub

Private Sub RemoveCharacter()
  Dim lPos As Long
  
  If Len(m_sValue) > 0 Then
    m_sValue = Left$(m_sValue, Len(m_sValue) - 1)
    lPos = InStr(1, m_sValue, ".")
    If lPos > 0 Then
      If Right$(m_sValue, 1) = "." Then RemoveCharacter
    End If
    m_bDecimalSign = (lPos > 0)
  End If
  
  DisplayValue m_sValue
End Sub


Private Sub DisplayValue(ByVal sValue As String)
  Dim dValue As Double
  
  lblDebug.Caption = sValue
  
  If Len(sValue) = 0 Then sValue = "0"
  If IsDouble(sValue, dValue) Then lblDisplay.Caption = Format(dValue, "#,#0.00")
End Sub

Private Function IsDouble(ByVal sValue As String, ByRef dValue As Double) As Boolean
  On Error GoTo errHandler
  dValue = CDbl(sValue)
  IsDouble = True
errHandler:
End Function

[Zvoni]

this code does not work same as i want textbox.
i want to work while typing in text box

Aircode! Not tested.

Private Sub Text1_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
    Case 32                      ' Backspace
    Case 127                     ' Delete
    Case 48 To 57                ' 0123456789
    Case Else: KeyAscii = 0      ' other
  End Select
End Sub

Private Sub Text1_Change()
   Text1.Text=Format(Text1.Text/100, "#,#0.00")
End Sub

[Hamidreza777]

None of the codes worked

[Arnoutdv]

Uh, you have to provide more information.
The code I posted does work when I tested it, maybe not exact for your situation but then you have to explain what doesn't work!

[Hamidreza777]

Uh, you have to provide more information.
The code I posted does work when I tested it, maybe not exact for your situation but then you have to explain what doesn't work!

thanks for spend time for my request.
your code work but is not exactlu i want code , let me explain more
1.your code only work on label after open form but i want user can enter digits in more text box fields in form
2.your code only can enter 2 digit after point.i want can enter more than two.
i attached a photo for explain more




please edite your code on this sample vb source.
thank you
Sample.zip

[Arnoutdv]

Nope I'm not going to correct your sample project.
We gave you enough ideas to get you starting.
The only simple way of having the thousands separator is using the format function.
But then you also have to specify the number of decimals.

Otherwise you have to write your own formatter or interpreter.

[Zvoni]

So the make or break-point for you is the entering of the decimal separator.
There is no other way for your Textbox to know when and where to set the commas.

Take one of those KeyPress-Events here, expand it to check for
KeyAscii=46 And not in Textbox (because then the KeyPress allows it, otherwise not)
At that moment use the Format-Function as shown.

[Zvoni]

Nope I'm not going to correct your sample project.
We gave you enough ideas to get you starting.
The only simple way of having the thousands separator is using the format function.
But then you also have to specify the number of decimals.

Otherwise you have to write your own formatter or interpreter.

Correct!
Split on the decimal-separator, lbound is the integer, ubound is the fraction, check length of ubound gives the number of digits in the fractional part to update the format-function on the fly

[Hamidreza777]

Thanks all,with "ComponentOne activex" i could do it.