CONVERTION D'UN NOMBRE EN UNE FRACTION

'***********************************************************************************************************
' Name       : xNum2Frac
' Purpose    : Converts a decimal number to a fraction.
'              eg: xNum2Frac(1.25) return 1 1/4
' Syntax     : xNum2Frac(Number)
' Parameters : Number   : Number to convert
' Return     : Number as a fraction
'***********************************************************************************************************
Public Function xNum2Frac(Number As Double) As String
    Dim strIntValue     As String
    Dim strDecValue     As String
    Dim strNumerator    As String
    Dim strDenominator  As String
    Dim strDecSep       As String
    Dim lngDecPosition  As Long
    
    On Error GoTo FracErr
    
    ' Retrieve the system decimal separator
    strDecSep = Mid(0.1, 2, 1)
    
    strIntValue = CStr(Number)
    lngDecPosition = InStr(1, strIntValue, strDecSep)
    
    If lngDecPosition Then
        strDecValue = Right(strIntValue, Len(strIntValue) - lngDecPosition)
        strIntValue = Left(strIntValue, lngDecPosition - 1)
        lngDecPosition = xGCF(CLng("1" & String(Len(strDecValue), "0")), CLng(strDecValue))
        strNumerator = CLng(strDecValue) / lngDecPosition
        strDenominator = CLng("1" & String(Len(strDecValue), "0")) / lngDecPosition
        xNum2Frac = IIf(strIntValue = "0", "", strIntValue) & " " & strNumerator & "/" & strDenominator
    Else
        xNum2Frac = strIntValue
    End If
    Exit Function

FracErr:
    Err.Raise 6, , "An error occured."
End Function


'***********************************************************************************************************
' Name       : xGCF
' Purpose    : Returns the Greatest Common Factor
'              i.e. The largest number which will evenly divide into both X and Y
' Syntax     : xGCF(Number1, Number2)
' Parameters : Number1  : 1st number
'              Number2  : 2nd number
' Return     : The Greatest Common Factor
'***********************************************************************************************************
Public Function xGCF(ByVal Number1 As Long, ByVal Number2 As Long) As Long
    Dim lngTemp As Long
    
    Number1 = Abs(Number1) 'Make both numbers positive
    Number2 = Abs(Number2)
    lngTemp = Number1 Mod Number2
    
    Do While lngTemp > 0
        Number1 = Number2
        Number2 = lngTemp
        lngTemp = Number1 Mod Number2
    Loop
    
    xGCF = Number2
End Function