This is my solution for taken a value or value and unit/info in a TextBoxW, including null value (empty string).
We have to include the Change event, and the KeyPress event (to handle "." and "," as decimal point. The validate part is optional, if you like to format the string when TextBoxW lost focus.
There are some helping functions for a module also. Works from clipboard input also.
The GetReal function check if the number is null (no number).
Using "/" we can add text, so if we have a value 12.455 and unit Kgr, we place 12.455/Kgr (or 12,455/Kgr for using comma for decimal separator character).
It is easy to get the number from the combined information:
With comma
Or with dot
To get the units (can be anything including another number, without any format or validation), we have to include one "/", so say we have resp$
return something or an empty string
If we leave empty the textbox, the validation event (if we use it) leave it as is.
Code:
Alignment = 1 - vbRightJustufy
AllowOverType = True ' its better
CausesValidation = TrueThere are some helping functions for a module also. Works from clipboard input also.
The GetReal function check if the number is null (no number).
Using "/" we can add text, so if we have a value 12.455 and unit Kgr, we place 12.455/Kgr (or 12,455/Kgr for using comma for decimal separator character).
It is easy to get the number from the combined information:
With comma
Code:
? Cdec(split("12,455/Kgr","/")(0))
? Cdec(split("12,455","/")(0))Code:
? Cdec(split("12.455/Kgr","/")(0))
? Cdec(split("12.455","/")(0))To get the units (can be anything including another number, without any format or validation), we have to include one "/", so say we have resp$
Code:
? split(resp$+"/")(1)If we leave empty the textbox, the validation event (if we use it) leave it as is.
Code:
Private Sub TextBoxW1_Change()
Dim a$
a$ = CleanStrNumeric(TextBoxW1.Text, "", 3)
If a$ <> TextBoxW1.Text Then
If TextBoxW1.Text <> Left$(a$, Len(TextBoxW1.Text)) Or InStr(a$, "\") > 0 Then
TextBoxW1.SelLength = 0
TextBoxW1.Text = a$
TextBoxW1.SelStart = Len(TextBoxW1.Text)
End If
End If
End Sub
Private Sub TextBoxW1_KeyPress(KeyChar As Integer)
If ChrW(KeyChar) = "." Or ChrW(KeyChar) = "," Then KeyChar = AscW(Format$(0, "#.#"))
End Sub
Private Sub TextBoxW1_Validate(Cancel As Boolean)
TextBoxW1.Text = CleanStr32Numeric(TextBoxW1.Text, "", 3)
End SubCode:
Public Function CleanStrNumeric(sStr As String, ValidcharListFirst As String, Optional ByVal maxdec As Integer = 3) As String
Dim a$, i As Long, c$, K As Integer, chck As Boolean, DecSep As Integer, once As Boolean, havedigits As Boolean
Dim R, decshowzero As Integer, decshow As Integer
DecSep = AscW(Format$(0, "#.#"))
decshow = maxdec: If decshow < 0 Then decshow = 0
decshowzero = decshow
maxdec = maxdec - 1
chck = Len(ValidcharListFirst) > 0
For i = 1 To Len(sStr)
c$ = Mid$(sStr, i, 1)
K = AscW(c$)
If Len(a$) = 0 Then
If chck Then
If InStr(ValidcharListFirst, c$) > 0 Then
a$ = a$ + c$: GoTo skipif
End If
End If
End If
If K = 47 And havedigits Then
If havedigits Then
R = CDec(a$)
c$ = FracStr(R, decshowzero, True)
a$ = CStr(R) + c$ + "/" + Mid$(sStr, i + 1)
GoTo skipfinal
Else
a$ = "0/"
End If
GoTo skipfinal
ElseIf havedigits And once And maxdec < 0 Then
' skip
ElseIf K > 47 And K < 58 Then
If once Then maxdec = maxdec - 1
a$ = a$ + c$
havedigits = True
ElseIf K = DecSep And Not once Then
once = True
If Not havedigits Then havedigits = True: a$ = a$ + "0"
If maxdec < 0 Then Exit For
a$ = a$ + c$
End If
skipif:
Next i
If havedigits Then
R = CDec(a$)
c$ = FracStr(R, decshowzero, True)
a$ = CStr(R) + c$
End If
skipfinal:
CleanStrNumeric = a$
End Function
Function FracStr(p, ByVal cut As Integer, Optional includedec As Boolean) As String
Dim s$, R
If cut = 0 Then p = Int(Abs(p)) * Sgn(p): Exit Function
R = Frac(p)
p = Int(Abs(p)) * Sgn(p)
If R = 0 Then
If cut > 0 Then FracStr = Left$(Format$(0, "#.#"), -includedec) + String$(cut, "0")
ElseIf cut > 0 Then
s$ = Mid$(CStr(R), 3 + includedec)
cut = cut - includedec
s$ = Left$(s$, cut)
cut = cut - Len(s$)
If cut > 0 Then
FracStr = s$ + String$(cut, "0")
Else
FracStr = s$
End If
Else
FracStr = Mid$(CStr(R), 3 + includedec)
End If
End Function
Function Frac(R)
Frac = Abs(Abs(R) - Int(Abs(R)))
End Function
Function GetReal(s As String, R) As Boolean
On Error Resume Next
R = CDbl(s)
GetReal = Err.Number = 0
Err.Clear