Code: Select all
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CLng(vLowerLimit) >= CLng(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Code: Select all
Option Explicit
#Const cModeDebug = False '*** Set to True when debugging & False for Production
' +-------------------------+ +----------+
'-------------------------| bVerifyTextBoxNumber() |-------------| 08/20/10 |
' +-------------------------+ +----------+
'Called by: Any procedure needing to verify numeric input!
'Notes: This routine only verifies numbers NOT DATES!
' If the optional arguments are used for Lower & Upper Limits
' the values passed are considered INVALID entries, i.e. a lower limit of
' Zero will NOT allow a Zero value entry! and an upper limit of 1,000 will
' NOT allow a value greater than 999 for whole numbers and 999.999... for
' Single, Double, and Currency types. If passing only an upper limit you
' must include the commas, i.e.
' --> bVerifyTextBoxNumber(iDatatype,zStrValue,,vUpperLimit)
' Conversion functions, e.g. CInt & CLng round funny...
' If the fractional part is EXACTLY .5 they round to the nearest
' EVEN number, thus; 2.5 rounds to 2 while 3.5 rounds to 4!
' This function, despite it's name can also be used to verify input
' from the INPUTBOX function.
Public Function bVerifyTextBoxNumber(iDataType As Integer, zStrValue, _
Optional vLowerLimit As Variant, _
Optional vUpperLimit As Variant) As Boolean
Dim bErrNumeric As Boolean
Dim bErrCommas As Boolean
Dim zDatatypes(18) As String
Dim zErrorData As String
zDatatypes(0) = "vbEmpty"
zDatatypes(1) = "vbNull"
zDatatypes(2) = "vbInteger"
zDatatypes(3) = "vbLong"
zDatatypes(4) = "vbSingle"
zDatatypes(5) = "vbDouble"
zDatatypes(6) = "vbCurrency"
zDatatypes(7) = "vbDate"
zDatatypes(8) = "vbString"
zDatatypes(9) = "vbObject"
zDatatypes(10) = "vbError"
zDatatypes(11) = "vbBoolean"
zDatatypes(12) = "Unknown"
zDatatypes(13) = "vbDataObject"
zDatatypes(14) = "vbDecimal"
zDatatypes(15) = "Unknown"
zDatatypes(16) = "Unknown"
zDatatypes(17) = "vbByte"
On Error GoTo ErrorTrap:
bVerifyTextBoxNumber = True
bErrNumeric = False
bErrNumeric = Not IsNumeric(zStrValue)
bErrCommas = InStr(zStrValue, ",,") > 0
If bErrNumeric Or bErrCommas Then
bVerifyTextBoxNumber = False
Exit Function
End If
#If cModeDebug Then '*** Construct Debug message ***
zErrorData = "Lower Limit is GREATER than or Equal to Upper Limit!" & _
vbCrLf & vbCrLf & "Data Type Requested: " & vbTab & zDatatypes(iDataType) & _
vbCrLf & "Data Value Passed: " & vbTab & vbTab & zStrValue & vbCrLf & _
"Lower Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
"Upper Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None")
#End If
Select Case iDataType
Case vbCurrency
If Not IsMissing(vLowerLimit) Then
If CCur(zStrValue) <= CCur(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CCur(zStrValue) >= CCur(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CCur(vLowerLimit) >= CCur(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbSingle
If Not IsMissing(vLowerLimit) Then
If CSng(zStrValue) <= CSng(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CSng(zStrValue) >= CSng(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CSng(vLowerLimit) >= CSng(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbDouble
If Not IsMissing(vLowerLimit) Then
If CDbl(zStrValue) <= CDbl(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CDbl(zStrValue) >= CDbl(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CDbl(vLowerLimit) >= CDbl(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbInteger
If Not IsMissing(vLowerLimit) Then
If CInt(zStrValue) <= CInt(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CInt(zStrValue) >= CInt(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CInt(vLowerLimit) >= CInt(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbLong
If Not IsMissing(vLowerLimit) Then
If CLng(zStrValue) <= CLng(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CLng(zStrValue) >= CLng(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CLng(vLowerLimit) >= CLng(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case Else
MsgBox "The data type { " & zDatatypes(iDataType) & _
" } is not supported by the bVerifyTextBoxNumber function." & _
vbCrLf & "Supported datatypes:" & vbCrLf & _
"vbCurrency; vbDouble; vbInteger;" & vbCrLf & _
"vbLong; and vbSingle", _
vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Unsupported Data Type"
bVerifyTextBoxNumber = False
End Select '*** Case iDataType ***
Exit Function
ErrorTrap:
zErrorData = "Data Type Requested: " & vbTab & zDatatypes(iDataType) & vbCrLf & _
"Data Value Passed: " & vbTab & vbTab & zStrValue & vbCrLf & _
"Lower Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
"Upper Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None")
Select Case Err()
Case 6: '*** OverFlow Error - Number too large for type ***
MsgBox "One of the arguments passed caused an Overflow error:" & _
vbCrLf & zErrorData, _
vbCritical + vbOKOnly, _
"bVerifyTextBoxNumber()- Error: Argument out of Range"
Exit Function
Case 13: '*** Type Mismatch Error - Can't convert to number ***
MsgBox "One of the arguments passed caused an Type Mismatch error:" & _
vbCrLf & zErrorData, _
vbCritical + vbOKOnly, _
"bVerifyTextBoxNumber()- Error: Argument out of Range"
Exit Function
Case Else
MsgBox "Error Number: " & Format(Err.Number) & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf & vbCrLf & _
"Contact your system programmer immediately!" & vbCrLf & vbCrLf & _
zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Unknown Error"
End Select
End Function '*** bVerifyTextBoxNumber ***