Option Compare Database   'Use database order for string comparisons
Option Explicit

Function Fraction (TheNumber) As String

    ' Black Sheep Productions
    ' Compuserve [74503,2251]

    ' Find the fractional equivalent ("K M/N", such as "1 7/8") for any
    ' double-precision number.  However, the results may turn out very
    ' strange for any number which can not be EXACTLY represented in a
    ' binary floating-point value, such as 1/3, 1/6, and so on.  Also,
    ' due to rounding and binary-to-decimal/decimal-to-binary conversion
    ' errors, the results become irregular as the total number of digits
    ' (integer portion AND fraction portion) increases.  For example,
    ' Fraction(7.785) yields a result of "7 157/200", while Fraction(457.785)
    ' yields a result of "457 196250000000006/250000000000000";  in the
    ' latter case, if you were to discard the low-order digits in both the
    ' numerator and denominator, the fraction would reduce to 157/200.
   
    Dim strNumber As String, intEPos As Integer, intDotPos As Integer
    Dim strMantissa As String, intExponent As Integer
    Dim int2Power As Integer, int5Power As Integer
    Dim dblWork As Double
    Dim strWhole As String, dblArg As Double
    Dim dblNumber As Double

    On Error GoTo Fraction_Error

    If IsNumeric(TheNumber) Then
        dblNumber = CDbl(TheNumber)
    Else
        Fraction = "! Not a number"
        Exit Function
    End If

    ' If there's no fractional part, just return the string
    ' that represents the number.
    If Fix(dblNumber) = dblNumber Then
        Fraction = Format$(dblNumber, "0")
        Exit Function
    End If

    dblArg = dblNumber

    ' Break out the whole and fractional parts
    Select Case dblArg
        Case Is > 1, Is < -1
            strWhole = CStr(Fix(dblArg)) & " "
            dblArg = dblArg - Fix(dblArg)
        Case Is < 0
            strWhole = "-"
        Case Else
            strWhole = ""
    End Select
    
    ' Convert the number to a string
    strNumber = CStr(Abs(dblArg))
    
    ' Number could be either:  .nnnnnnnn -or- .nnnnnnnE-nnn
    ' Break it into mantissa (left of "E") and exponent (right of "E")
    intEPos = InStr(strNumber, "E")
    If intEPos = 0 Then
        strMantissa = strNumber
        intExponent = 0
    Else
        strMantissa = Left(strNumber, intEPos - 1)
        intExponent = CInt(Mid(strNumber, intEPos + 1))
    End If
    
    ' Normalize it so that the mantissa is always in the format ".nnnnn"
    intDotPos = InStr(strMantissa, ".")
    If intDotPos > 1 Then
        intExponent = intExponent + (intDotPos - 1)
        strMantissa = "." & Left(strMantissa, intDotPos - 1) & Mid(strMantissa, intDotPos + 1)
    End If

    ' Now make the mantissa be a whole number, and adjust the exponent accordingly
    strMantissa = Mid(strMantissa, 2)
    intExponent = intExponent - Len(strMantissa)
    
    ' Now, the denominator is always (2^n)*(5^n), lets start with those as factors
    int2Power = Abs(intExponent)
    int5Power = Abs(intExponent)
    dblWork = CDbl(strMantissa)

    ' Divide by 2 up to "n" times, as long as we keep getting no fractional part
    For int2Power = int2Power To 1 Step -1
        If Right(Format(dblWork / 2#, "0.0"), 1) = 0 Then
            dblWork = dblWork / 2#
        Else
            Exit For
        End If
    Next int2Power

    ' Now, divide by 5 up to "n" times, as long as we get no fractional part
    For int5Power = int5Power To 1 Step -1
        If Right(Format(dblWork / 5#, "0.0"), 1) = 0 Then
            dblWork = dblWork / 5#
        Else
            Exit For
        End If
    Next int5Power

    Fraction = strWhole & CStr(dblWork) & "/" & Trim(Format((2 ^ int2Power) * (5 ^ int5Power), "0"))

Fraction_Exit:
    Exit Function

Fraction_Error:
    Fraction = "! Error " & Err & " occurred in Fraction function"
    Resume Fraction_Exit
    
End Function