Just paste this code into any module (this is the desired way) or form. To do this, open up your project and insert a new Module. Change the name of the module to basMath and paste this code into the module.
'----------------------------------------------------------------------
'
' Module Name: basMath
' Written By: C&D Programming Corp.
' Create Date: 1/5/98
' Copyright: Copyright 1997-98 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'
' Purpose: Determine the decimal equivalent of a fraction
' or whole number.
'
'
' Example Calls:
' dValue = FractionValue("1 1/2")
' dValue = FractionValue("6 7/16")
'
'----------------------------------------------------------------------
Function FractionValue(ByVal sFraction As String) As Double
Dim iSpace As Integer
Dim iSlash As Integer
Dim sFractPart As String
Dim dFractValue As Double
Dim sWholePart As String
On Error Goto Handler
' Just in case a Null String is passed here, we use the
' concatenation trick.
If "" & sFraction = "" Then
FractionValue = 0
Exit Function
End If
' Find the location of the space that separates the
' whole number from the fraction.
iSpace = InStr(sFraction, " ")
' Find the slash in the fraction.
iSlash = InStr(sFraction, "/")
' If we have a fractional part, start the process to
' figure out the decimal equivalent of the fraction.
If iSlash > 0 Then
' Separate the string into the whole number
' portion and the fractional portion.
If iSpace = 0 Then
sFractPart = sFraction
sWholePart = "0"
Else
sFractPart = Mid$(sFraction, iSpace + 1)
sWholePart = Left(sFraction, iSpace - 1)
End If
' Do the calculations to convert the mixed number
' into a decimal number.
iSlash = InStr(sFractPart, "/")
If iSlash = 0 Then
dFractValue = CDbl(Left(sFraction, iSpace - 1))
Else
dFractValue = Left$(sFractPart, iSlash - 1) / Mid$(sFractPart, iSlash + 1)
dFractValue = dFractValue + CDbl(sWholePart)
End If
Else
' There is no fraction, so just take the value of this number.
dFractValue = Val(sFraction)
End If
FractionValue = dFractValue
Handler:
Err.Raise Err.Number, "FractionValue", Err.Description
End Function