function ' function to achieve decimal fractions
Public Function xtof (str as Currency, Optional fenm as Integer =) as String ' is limited to divisible fractions
Dim CFM as Currency
Dim Cfmmod as Integer
On Error GoTo erroreof
CFM = 1/fenm
Xtof = ""
If str = 0 Then xtof = "": Exit Function
Dim Point as Integer
Dim DInt as String
Dim Dpoint as Currency
Dim Fint, Fint1, Fint2 as Integer
If Str <> 0 Then
If str > 1 Then
Point = INSTR (1, str, ".", 1)
If point = 0 Then
Xtof = str:
Exit Function
Else
DINT = Mid (str, 1, point-1)
Dpoint = CCur ("0." & Mid (str, point + 1))
Fint = INSTR (1, Xtof (dpoint), "/", 1)
Fint1 = CInt (Mid (Xtof (Dpoint), 1, fint-1))
Fint2 = CInt (Mid (Xtof (dpoint), Fint + 1))
Xtof = CStr (dInt * fint2 + fint1) & "/" & CStr (Fint2)
End If
Else
If fenm Mod CInt (str/cfm) = 0 Then
Xtof = "1/" + CSTR (Fenm/cint (str/cfm))
Else
Cfmmod = Maxgys (Fenm, CInt (str/cfm))
Xtof = CStr (CInt (str/cfm/cfmmod)) + "/" + CStr (CInt (Fenm/cfmmod))
End If
End If
Else
Xtof = "0"
End If
Exit Function
Erroreof:
Xtof = ""
End Function
Function maxgys (num1 As Integer, num2 as Integer) As Integer
Dim Minnum, I as Integer
Minnum = NUM1
If num1 > num2 Then minnum = num2
For i = 1 to Minnum
If ((num1 mod i) = 0) and ((num2 mod i) = 0) Then Maxgys = i
Next I
End Function