Public Type Fraction
WholeNumber As Long
Numerator As Long
Denominator As Long
End Type
Public Function GetFraction(ByVal TheDecimal As Double, Optional ByVal Accuracy As Double = 0.0078125) As Fraction
'Lets go 10 places
Const places = 1000000000
Dim GCD As Long
Dim decimalPart As Double
GetFraction.WholeNumber = Fix(TheDecimal)
decimalPart = TheDecimal - GetFraction.WholeNumber
decimalPart = Accuracy * CLng(decimalPart / Accuracy)
GetFraction.Numerator = Fix(decimalPart * places)
GetFraction.Denominator = places
GCD = GetGCD(GetFraction.Numerator, GetFraction.Denominator)
GetFraction.Numerator = GetFraction.Numerator / GCD
GetFraction.Denominator = GetFraction.Denominator / GCD
End Function
Public Function GetGCD(ByVal a As Long, ByVal b As Long) As Long
Do While a <> b
If a > b Then
a = a - b
Else
b = b - a
End If
Loop
GetGCD = a
End Function
Public Function GetFractionToString(TheDecimal As Double, Optional Accuracy As Double = 0.0078125) As String
Dim TheFraction As Fraction
TheFraction = GetFraction(TheDecimal, Accuracy)
GetFractionToString = CStr(TheFraction.Numerator) & "/" & CStr(TheFraction.Denominator)
If TheFraction.WholeNumber <> 0 Then GetFractionToString = TheFraction.WholeNumber & " " & GetFractionToString
End Function
Public Sub tet()
Dim x As Double
Dim acc As Double
acc = 1 / 8
x = 3 + 1 / 2
Debug.Print GetFractionToString(x, acc)
End Sub