TheSwamp
Code Red => VB(A) => Topic started by: David Hall on May 07, 2007, 03:15:06 PM
-
Is there a better way to streamline this code?
If IsNumeric(txtLengthFt) Then
If txtLengthFt.Value Mod 1 = 0 Then
intL = CInt(txtLengthFt) * 12
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.Show
End If
If IsNumeric(txtLengthIn) Then
If txtLengthIn.Value Mod 1 = 0 Then
intL = intL + CInt(txtLengthIn)
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.Show
End If
I have my logic worked out to determine if a user puts in a numeric value, but I didn't know if this was the best, most efficient way to do this
-
You could simply restrict the textbox to only allow numbers, thereby avoiding having to check if the value is a number or not.
Private Sub txtLengthFt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
End Select
End Sub
-
Thanks Matt!
I learned something also :-)
-
thanks Matt!
What happens if they press a non-number, nothing? I have never used that, so I am trying it now, but thought I would ask to see if there were any gotcha's I should know about.
-
That is SWEET!! I never knew you could do that.
Thanks Matt
-
Now that you showed me that, I will show you what you just saved me from
If IsNumeric(txtLengthFt) Then
If txtLengthFt.Value Mod 1 = 0 Then
intL = CInt(txtLengthFt) * 12
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.txtLengthFt.SetFocus
Me.txtLengthFt.SelStart = 0
Me.txtLengthFt.SelLength = Len(txtLengthFt)
Me.Show
End If
If IsNumeric(txtLengthIn) Then
If txtLengthIn.Value Mod 1 = 0 Then
intL = intL + CInt(txtLengthIn)
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.txtLengthFt.SetFocus
Me.txtLengthIn.SelStart = 0
Me.txtLengthIn.SelLength = Len(txtLengthFt)
Me.Show
End If
If IsNumeric(txtWidthFt) Then
If txtWidthFt.Value Mod 1 = 0 Then
intW = CInt(txtWidthFt) * 12
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.txtWidthFt.SetFocus
Me.txtWidthFt.SelStart = 0
Me.txtWidthFt.SelLength = Len(txtWidthFt)
Me.Show
End If
If IsNumeric(txtWidthIn) Then
If txtWidthIn.Value Mod 1 = 0 Then
intW = intW + CInt(txtWidthIn)
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.txtWidthFt.SetFocus
Me.txtWidthIn.SelStart = 0
Me.txtWidthIn.SelLength = Len(txtWidthFt)
Me.Show
End If
If IsNumeric(txtHeightFt) Then
If txtHeightFt.Value Mod 1 = 0 Then
intH = CInt(txtHeightFt) * 12
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.txtHeightFt.SetFocus
Me.txtHeightFt.SelStart = 0
Me.txtHeightFt.SelLength = Len(txtHeightFt)
Me.Show
End If
If IsNumeric(txtHeightIn) Then
If txtHeightIn.Value Mod 1 = 0 Then
intH = intH + CInt(txtHeightIn)
Else
MsgBox "Enter a valid Length"
Me.Show
End If
Else
MsgBox "Enter a valid Length"
Me.txtHeightFt.SetFocus
Me.txtHeightIn.SelStart = 0
Me.txtHeightIn.SelLength = Len(txtHeightFt)
Me.Show
End If
-
ok, since I got that, let me ask this question. 3 of the txt boxes are used for inches. I was thinking of using CInt() to convert to integer, and doing a < 12 check to make sure they didn't go over where they shouldn't. Any other ideas
-
on a side note, whilst error checking a valid integer in the previous code, I was popping a msgbox, and sending them back to the form with the offending txtbox highlighted. BUT, then they had to click the GO button a second time, which is seeming to put the function in a loop. Should I clear the values of the variables and repopulate them when the data is finally good?
-
ok, since I got that, let me ask this question. 3 of the txt boxes are used for inches. I was thinking of using CInt() to convert to integer, and doing a < 12 check to make sure they didn't go over where they shouldn't. Any other ideas
You could do something like this:
Private Sub TextBox1_Change()
If TextBox1.Value > 12 Then
MsgBox "Whoa pardner! Nothing greater than 12 is allowed here!", vbCritical + vbOKOnly
' Enter a value of '0' in the textbox
TextBox1.Text = "0"
' Highlight the text in the textbox for immediate re-entry of number(s)
TextBox1.SelStart = 0
TextBox1.SelLength = TextBox1.TextLength
End If
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
End Select
End Sub
-
Look at why the function loops the second time, it shouldn't just validate the data and move on. Do not clear the data your users have entered, it'd be silly to have to enter it all again because you screwed up one field.
If validatedata then
blah blah
else
msgbox "You lush! this is wrong!"
endif
-
I relooked at what I was doing. Firstly, I moved all my validation code out of the button click event, thus getting rid of the problem. Secondly, I narrowed down why it was looping. It was because I fired the event, and didn't exit the click event when I went back to the form, so the event ran a second time after they update the info problem.
-
Nice stuff Matt
CmdrDuh- if your code is not in the click event, how do you exit it?
-
Using Matt's suggestion, I used this
Private Sub txtLengthFt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
End Select
End Sub
and this
Private Sub txtLengthIn_Change()
If txtLengthIn.Value >= 12 Then
MsgBox "Whoa the Pony, Nothing greater than 12", vbCritical + vbOKOnly
txtLengthIn.Text = "0"
txtLengthIn.SelStart = 0
txtLengthIn.SelLength = txtLengthIn.TextLength
End If
End Sub
to check the values. Once all txtBoxes are filled in, and valid based on above 2 checks, the click event is enabled. (there are more than 2 checks, I just pasted 2 of them to show what Im doing. All 6 boxes have the same type of error validation)
-
Here's a slightly modified version of what have...
If you enter a value GREATER than 12, it will prompt you to convert the inches to feet.
Private Sub txtLengthIn_Change()
Dim vbResult As Long
If txtLengthIn.Value >= 12 Then
vbResult = MsgBox("Since you're attempting to enter a value GREATER than 12, would you like to convert it to FEET?", vbQuestion + vbYesNo, "Way to go!")
If vbResult = vbYes Then
MsgBox "Converted value = " & txtLengthIn / 12
ElseIf vbResult = vbNo Then
MsgBox "Start over!"
txtLengthIn.Text = "0"
txtLengthIn.SelStart = 0
txtLengthIn.SelLength = txtLengthIn.TextLength
End If
End If
End Sub
This will allow you to add a PERIOD in the number (in case you don't work with whole inches).
Private Sub txtLengthIn_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr(1, txtLengthIn.Text, ".") > 0 And KeyAscii = Asc(".") Then
KeyAscii = 0
Exit Sub
End If
Select Case KeyAscii
Case Asc("0") To Asc("9"), Asc(".")
Case Else
KeyAscii = 0
End Select
End Sub
Just something else you might want to think about.
-
Good thoughts. I will have to see if I can make use of those. I like the added period option, as our civil engineers are always using ##.#' format.
-
@Arizona
Hi nice to see you around.
@CmdrDuh,
As you probably have realized you can use this code for several Textboxes to limit input....
But Why Write or paste/copy it again and again.....
Write a class to wrap your textboxes, raise events to indicate illegal input (MaxedOut if a value is to high)
allow only one decimal seperator.... if you write such code once in a class module and testit you can use it many times.
The trick is to define a textbox object in the class module and make it point at the textbox on your form.
The code below is an example of a european textbox wrapper to limit input to numbers only (VB 6.0 class)
Option Explicit
'Author: B.J.G.Nieuwhof
'Mail: Info@ driesign.nl
'Usage: AT YOUR OWN RISK, Leaving comments intact and in place.
'Have Fun
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Public WithEvents TextBox As TextBox
Event MaxedOut(BouncedValue As Double)
Event DivedUnder(BouncedValue As Double)
Event MaxedPrecision(BouncedValue As Double)
Event DoublePrecision()
Event IllegalCharacter(Character As String)
Event NoValue()
Private m_MaxValue As Double
Private MinValueSet As Boolean
Private m_MinValue As Double
Private MaxValueSet As Boolean
Private m_MaxTemp As Double
Private m_MinTemp As Double
Private LocalDecimalSeparator As Long
Private m_MaxDigits As Integer
Private m_BeepOnError As Boolean
Private m_bRaiseAssignmentErrors As Boolean
Private Sub Class_Terminate()
Set Me.TextBox = Nothing
End Sub
Private Sub Class_Initialize()
LocalDecimalSeparator = Asc(Mid$(Format$(1.5, "0.0"), 2, 1))
m_bRaiseAssignmentErrors = True
End Sub
Private Sub TextBox_KeyPress(KeyAscii As Integer)
Dim SepPos As Long
Dim Txt As String, TmpTxt As String
Dim PlusKey As Double
Dim Ln As Long, SLn As Long, St As Long
SLn = Me.TextBox.SelLength
St = Me.TextBox.SelStart
Ln = Len(Me.TextBox)
If SLn = 0 Then
Txt = Me.TextBox
Else
If St > 0 Then
Txt = Left$(Me.TextBox, St)
End If
If St + SLn < Ln Then
Txt = Txt & Right$(Me.TextBox, Ln - (St + SLn))
End If
End If
If MaxValueSet And MaxValue < 0 And Left$(Txt, 1) <> "-" Then
Txt = "-" & Txt
Me.TextBox = Txt
Me.TextBox.SelStart = 1
St = 1
SLn = 0
If KeyAscii <> 45 And MaxValueSet = True And MaxValue < 0 Then
If IsNumeric(Chr$(KeyAscii)) Then
RaiseEvent MaxedOut(CDbl(Chr$(KeyAscii)))
If m_BeepOnError Then Beep 4000, 50
End If
End If
End If
Select Case KeyAscii
Case 0 To 31
Case 48 To 57
SepPos = InStr(1, Txt, Chr(LocalDecimalSeparator))
If St = Len(Txt) Then
PlusKey = CDbl(Txt & Chr(KeyAscii))
Else
If St > 0 Then
TmpTxt = Left$(Me.TextBox, St) & Chr$(KeyAscii)
End If
If St + SLn < Ln Then
TmpTxt = TmpTxt & Right$(Txt, Ln - (St + SLn))
End If
PlusKey = CDbl(TmpTxt)
End If
If SepPos > 0 And (Len(Txt) - SepPos) >= MaxDigits And St > SepPos Then
RaiseEvent MaxedPrecision(CDbl(Txt & Chr(KeyAscii)))
If m_BeepOnError Then Beep 3000, 50
KeyAscii = 0
ElseIf PlusKey > m_MaxTemp And MaxValueSet Then
RaiseEvent MaxedOut(CDbl(Txt & Chr$(KeyAscii)))
KeyAscii = 0
If m_BeepOnError Then Beep 4000, 50
ElseIf PlusKey < m_MinTemp And MinValueSet Then
KeyAscii = 0
RaiseEvent DivedUnder(CDbl(Txt & Chr(KeyAscii)))
If m_BeepOnError Then Beep 2000, 50
End If
Case LocalDecimalSeparator ' Accept LocalDecimalSign
'reject second decimal char
If m_MaxDigits > 0 Then
If InStr(1, Txt, Chr(LocalDecimalSeparator)) Then
RaiseEvent DoublePrecision
If m_BeepOnError Then
Beep 2000, 25
Beep 3000, 25
End If
KeyAscii = 0
End If
Else
'raising precision event because an attempt was made to create a decimal part without
'digits allowed.
RaiseEvent MaxedPrecision(CDbl(Me.TextBox))
If m_BeepOnError Then
Beep 4000, 30
Beep 4500, 20
End If
KeyAscii = 0
End If
Case 43, 45
'plus and minus
If St > 0 Then
KeyAscii = 0
ElseIf MinValueSet And MinValue >= 0 And KeyAscii = 45 Then
KeyAscii = 0
ElseIf MaxValueSet And MaxValue <= 0 And KeyAscii = 43 Then
KeyAscii = 0
End If
Case Else
KeyAscii = 0 ' Reject anything else.
End Select
End Sub
Public Property Get MaxValue() As Double
MaxValue = m_MaxValue
End Property
Public Property Let MaxValue(ByVal dMaxValue As Double)
If dMaxValue < m_MinValue And MinValueSet Then
m_MinValue = dMaxValue
End If
m_MaxValue = dMaxValue
MaxValueSet = True
If m_MaxValue <= 0 Then
m_MaxTemp = 0
Me.TextBox = m_MaxValue
Me.TextBox.SelStart = 1
Me.TextBox.SelLength = Len(Me.TextBox)
Else
m_MaxTemp = dMaxValue
End If
End Property
Public Property Get MinValue() As Double
MinValue = m_MinValue
End Property
Public Property Let MinValue(ByVal dMinValue As Double)
If dMinValue > m_MaxValue And MaxValueSet Then
m_MaxValue = dMinValue
End If
m_MinValue = dMinValue
MinValueSet = True
If dMinValue >= 0 Then
m_MinTemp = 0
Me.TextBox = dMinValue
Me.TextBox.SelStart = 0
Me.TextBox.SelLength = Len(Me.TextBox)
Else
m_MinTemp = dMinValue
End If
End Property
Public Property Get MaxDigits() As Integer
MaxDigits = m_MaxDigits
End Property
Public Property Let MaxDigits(ByVal MaxDigits As Integer)
m_MaxDigits = MaxDigits
End Property
Public Property Get BeepOnError() As Boolean
BeepOnError = m_BeepOnError
End Property
Public Property Let BeepOnError(ByVal bBeepOnError As Boolean)
m_BeepOnError = bBeepOnError
End Property
Public Property Get Value() As Double
If Len(Me.TextBox & "") = 0 Then ResetEmptyBox
Value = CDbl(Replace(Me.TextBox.Text, LocalDecimalSeparator, "."))
End Property
Public Property Let Value(ByVal dValue As Double)
If dValue < MinValue And MinValueSet Then
RaiseEvent DivedUnder(dValue)
ElseIf dValue > MaxValue And MaxValueSet Then
RaiseEvent MaxedOut(dValue)
Else
Me.TextBox = Replace(CStr(dValue), ".", LocalDecimalSeparator)
End If
End Property
Public Property Get Text() As String
Text = Me.TextBox
End Property
Public Property Let Text(ByVal sText As String)
Dim Txt As String
Dim Val As Double
Dim L As Long
Txt = Replace(sText, LocalDecimalSeparator, ".")
If Not IsNumeric(Txt) Then
RaiseEvent IllegalCharacter(sText)
Exit Property
End If
Txt = Replace(sText, ".", LocalDecimalSeparator)
L = InStr(1, Txt, LocalDecimalSeparator)
If L > 0 Then
L = InStr(L, Txt, LocalDecimalSeparator)
If L > 0 Then
RaiseEvent DoublePrecision
If m_bRaiseCodeInputErrors Then Err.Raise vbObjectError + 10, , "Double Precision sign in assigninng" & vbCrLf & "Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & "):" & sText
Exit Property
End If
If Len(sText) - L > m_MaxDigits Then
RaiseEvent MaxedPrecision(CDbl(sText))
If m_bRaiseAssignmentErrors Then Err.Raise vbObjectError + 11, , "To much digits in assigninng" & vbCrLf & "Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & "):" & sText
Exit Property
End If
End If
Val = CDbl(sText)
If MaxValueSet And Val > MaxValue Then
RaiseEvent MaxedOut(Val)
If m_bRaiseAssignmentErrors Then Err.Raise vbObjectError + 11, , "Overshooting " & MaxValue & " with assingning " & sText & vbCrLf & " Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & ")"
Exit Property
ElseIf MinValueSet And Val < MinValue Then
RaiseEvent DivedUnder(Val)
If m_bRaiseAssignmentErrors Then Err.Raise vbObjectError + 11, , "Undershooting " & MinValue & " with assingning " & sText & vbCrLf & " Text to ClsNumbersOnly.Textbox(" & Me.TextBox.Name & ")"
Exit Property
Else
Me.TextBox = Txt
End If
End Property
Public Property Get RaiseAssignmentErrors() As Boolean
m_bRaiseAssignmentErrors = m_bRaiseAssignmentErrors
End Property
Public Property Let RaiseAssignmentErrors(ByVal bRaiseCodeInputErrors As Boolean)
m_bRaiseAssignmentErrors = bRaiseCodeInputErrors
End Property
Private Sub TextBox_Validate(Cancel As Boolean)
Dim Val As Double
If Len(Me.TextBox & "") = 0 Then
RaiseEvent NoValue
Cancel = True
If m_BeepOnError Then
Beep 4000, 30
Beep 4900, 20
Beep 4000, 30
End If
ResetEmptyBox
Else
Val = CDbl(Replace(Me.TextBox, LocalDecimalSeparator, "."))
If Val > m_MaxValue And MaxValueSet Then
RaiseEvent MaxedOut(Val)
Cancel = True
ElseIf Val < m_MinValue And MinValueSet Then
RaiseEvent DivedUnder(Val)
Cancel = True
End If
End If
End Sub
Private Function ResetEmptyBox()
If m_MaxValue >= 0 And m_MinValue <= 0 Then
Me.TextBox = "0"
Me.TextBox.SelLength = 1
ElseIf m_MinValue > 0 Then
Me.TextBox = m_MinValue
Me.TextBox.SelLength = Len(Me.TextBox)
Else
If m_MaxValue < 0 Then
Me.TextBox = m_MinValue
Me.TextBox.SelStart = 1
Me.TextBox.SelLength = Len(Me.TextBox) - 1
End If
End If
End Function
Public Property Set Init(TextBoxToWrap As TextBox)
Set Me.TextBox = TextBoxToWrap
End Property
Place the code in a class (named:ClsNumbersOnly)
In a form with a textbox called Text1 use this code for example:Option Explicit
Dim WithEvents Tbox1Wrap As ClsNumbersOnly
Private Sub Form_Load()
Set Tbox1Wrap = New ClsNumbersOnly
Tbox1Wrap.MaxDigits = 2
Tbox1Wrap.MaxValue = 12
Set Tbox1Wrap.Init = Me.Text1
End Sub
Private Sub Tbox1Wrap_MaxedOut(BouncedValue As Double)
'do something with te keystroke if you like to
End Sub
I know this code will probably be a blur to you at the start but try to understand it.... and I will welcome you on your first step on the threshold of Object Ooriented Programming (OOP)
Have Fun.
-
Looks great Berend, but like you say will take a while to digest.
-
Yes it will, but if you do it will open up a lot of possibility's and upgrade your coding capabillity's
So I thought I give some good but complex code to challenge Cmdruh (and others).
It's also a step toward using VB or VB.net by scratching the surface of OOP.
BTW nice to see you around as well.
-
@Arizona
Hi nice to see you around.
Hi Berend!
Good to see you again :-)
Nice code BTW!
-
Im going to have to look at that for a while, but it makes sense. See if I can implement it fairly quickly.
-
If you get stuck on something just ask and you can mail me if no one reply's.
I'm not a frequent visitor on this forum so after a 48 hour silence.... info @ driesign .nl
without the spaces (added them to avoid mail adres leeching software)
have fun.