|
|
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: CODE 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: CODE '==============================================================================
' 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
|
| This page has been accessed 3,508 times. This page was last modified 09:33, 6 April 2011 by Jack Leach. Disclaimers |