Função de conversão de Decimal para Fração

Função para converter de decimal para fração. (ATENÇÃO: foi testada rapidamente com alguns poucos valores)

Limitei até a 4a. casa decimal devido à estouros de memória.

Se alguém souber uma solução para calcular acima desta quantidade serei muito grato (acho que deve existir algum outro jeito sim).

Entrada é um número decimal
Saída uma string com a fração

Código:

Public Function CFracao(Valor) As String
'Função para conversão de decimal para fracao
'Criada por thiagomcosta@yahoo.com.br
Dim vQtdeCasasDecimais As Integer
Dim vDiminui As Double
Dim vNumera As Long
Dim vDenom As Long
Dim vConstat As Long
Dim vSimpl As Long

'Conta a quantidade de casas decimais
vDiminui = Valor - Int(Valor)
vQtdeCasasDecimais = Len(CStr(vDiminui)) - 2
If vQtdeCasasDecimais <= 0 Then
    CFracao = CStr(Valor)
    Exit Function
End If

If vQtdeCasasDecimais > 4 Then vQtdeCasasDecimais = 4

vConstat = 10 ^ vQtdeCasasDecimais

'Define os numeradores e denomidores
vNumera = Int(Valor * vConstat)
vDenom = Int(vConstat)

'Simplifica a fração
vSimpl = 2
Do While vNumera > 1 And vDenom > 1 And vSimpl <= vDenom And vSimpl <= vNumera
    If vNumera Mod vSimpl = 0 And vDenom Mod vSimpl = 0 Then
        vNumera = vNumera / vSimpl
        vDenom = vDenom / vSimpl
        vSimpl = vSimpl - 1
    End If
    vSimpl = vSimpl + 1
Loop

CFracao = vNumera & "/" & vDenom

End Function

Ok! Muito obrigado pela ajuda! Grande Abraço!