This function is similar to the builtin Eval function, but instead returns the value of a mixed number (ex. 1-1/4). This is useful in situations where the user might be entering a size dimension into an unbound field, or other situations where a user may desire to enter a fractional value in an unbound field.
Examples of valid numbers and returns when using IsMixedNumber and EvalMixedNum:
IsMixed: 1 True, Evals to: 1 IsMixed: 1.5 True, Evals to: 1.5 IsMixed: 1/2 True, Evals to: 0.5 IsMixed: -1/2 True, Evals to: -0.5 IsMixed: -1.75 True, Evals to: -1.75 IsMixed: 1 3/8 True, Evals to: 1.375 IsMixed: 1-3/8 True, Evals to: 1.375 IsMixed: -1 3/8 True, Evals to: -1.375 IsMixed: 1 15/2 True, Evals to: 8.5 IsMixed: +1-1/2 True, Evals to: 1.5 IsMixed: 1-3.5/8 False, Evals to: INVALID IsMixed: 1.5-1/2 False, Evals to: INVALID
See comments in the function header for usage and notes throughout the function for some descriptions on what’s going on.
Dependancies:
Office 2000 or later (or replacement Split() and Replace() functions)
IsMixedNumber
IsFraction
Function:
'==============================================================================
' NAME: EvalMixedNum
'
' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
'
' PURPOSE: Evaluates a mixed number or single fraction
' RETURNS: Double, number equivelant to the expression passed. Returns 0
' on errors, so make SURE the calling design is proofed well to avoid
' mishaps.
'
' ARGUMENTS: sInput, string, an expression of one of the following syntaxes:
' ARG RET
' "1-1/2" (1.5)
' "1 1/2" (1.5)
' "11/2" (5.5)
' "1" (1)
' "-2-7/8" (-2.875)
' "-2 7/8" (-2.875)
'
' DEPENDANCIES:
' Access 2000+ (requires Replace and Split functions for earlier versions)
' IsMixedNumber() (http://www.utteraccess.com/wiki/index.php/IsMixedNumber)
' IsFraction() (http://www.utteraccess.com/wiki/index.php/IsFraction)
' *IsFraction is required indirectly by the IsMixedNumber function
'
'
' REVISIONS:
' REV | DATE | REV TYPE | DESCRIPTION
'------------------------------------------------------------------------------
' R01 2010/08/19 INITIAL
' R02 2010/12/10 MINOR Includes call to IsMixedNumber() to verify
' input, other general tidying-up
'
'
' NOTES:
'
' This function does NOT handle expressions that contain multiple numbers.
' For example, "1-1/2 + 2-3/8" is invalid and will fail. The correct calling
' structure for this expression would be:
' =EvalMixedNum("1-1/2") + EvalMixedNum("2-3/8")
'
'==============================================================================
'ErrHandler V3.01
Public Function EvalMixedNum(ByVal sInput As String) As Double
On Error GoTo Error_Proc
Dim Ret As Double
'=========================
'Error constants
Const ERRN_EXPRESSION_SYNTAX As Long = vbObjectError + 7001
Const ERRM_EXPRESSION_SYNTAX As String = _
"The syntax [||] is not valid!"
'variables
Dim bIsNegative As Boolean 'flag this so we can negate the final value
Dim v As Variant 'variant array to store the elements of the expression.
'=========================
sInput = Trim(sInput)
If Not IsMixedNumber(sInput) Then
Err.Raise ERRN_EXPRESSION_SYNTAX, , _
Replace(ERRM_EXPRESSION_SYNTAX, "||", sInput)
GoTo Exit_Proc
End If
If Len(sInput) = 0 Then GoTo Exit_Proc
'eval for a negative value
If Left(sInput, 1) = "-" Then
bIsNegative = True
'trim the sign
sInput = Right(sInput, Len(sInput) - 1)
End If
'check for whole num to fraction seperator (space or dash)
If InStr(1, sInput, " ") <> 0 Then
'a space seperator is likely used
v = Split(sInput, " ")
ElseIf InStr(1, sInput, "-") <> 0 Then
'a dash seperator is likely used
v = Split(sInput, "-")
Else
'no sperator, should be a straight conversion
v = Split(sInput)
End If
'get the return
If UBound(v) = 0 Then
Ret = CDbl(Eval(v(0)))
Else
Ret = CDbl(Eval(v(0))) + CDbl(Eval(v(1)))
End If
'negate the return if required
If bIsNegative Then Ret = Ret * (-1)
'=========================
Exit_Proc:
EvalMixedNum = Ret
Exit Function
Error_Proc:
Select Case Err.Number
Case Else
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: lmthNumberManips, Procedure: EvalMixedNum" _
, vbCritical, "Error!"
End Select
Resume Exit_Proc
Resume
End Function