Convertion d'un nombre en une fraction

Commenter

Contenu du snippet

Convertion d'un nombre en une fraction.
Exemple: 10,25 donne 10 1/4

Source / Exemple : 


'***********************************************************************************************************
' 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

Conclusion :


La fonction xNum2Frac se charge de faire la convertion.
Elle utilise la fonction xGCF (egalement dans les sources) pour trouver le plus grand denominateur commun.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Mr X)