Convertir numeros a letras

Weno estaba sin nada que hacer entonces me lo puse a razonar, éste código no está optimizado.
No programo de una manera determinada, lo hago con respecto a las reacciones cerebrales dependiendo de ciertos estímulos, oséa que mañana lo puedo pensar de una manera diferente... acá dejo el código (Y).

PD: no sé hasta que número capta bien. créo que hasta 999.999.999
PD2: pueden haber errores gramaticales *-) :silbar:

Código

[Form]
Option Explicit
 
Private Sub Command1_Click()
 
Text2.Text = NumersToLetters(Val(Text1.Text))
 
Exit Sub
'1226
'y que devuelva:
'mil doscientos veinte y seis....
Dim num As Double
 
'num = 1.000.000.000.000
num = 1000000000000#
 
MsgBox num
 
MsgBox Val(Text1.Text)
End Sub
 
Private Sub Form_Load()
'Dim p As Byte
 
'p = 99
 
'Select Case p
'    Case 1 To 99
'        MsgBox "< 100"
'    Case Else
'        MsgBox "> 100"
'End Select
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If IsNumeric(Chr(KeyAscii)) <> True Then KeyAscii = 0
End Sub

Código

Option Explicit
'----------------------------------------------------------------------------------------
' Module            : NumbersToLetters
' Purpose           : Numbers to letters
' Author            : Misery
' DateTime_Begin    : 09/05/2011
' DateTime_End      : 10/05/2011
'----------------------------------------------------------------------------------------
 
'http://roble.pntic.mec.es/msanto1/ortografia/numeros.htm
 
'unidad = cero, uno, dos, tres, cuatro, cinco, seis, siete, ocho, nueve, diez
'decena = once, doce, trece, catorce, quince, ->(Ahora aparece el Copy Paste) dieciséis, diecisiete,
    'dieciocho, diecinueve, veinte, veintiuno, veintidós, veintitrés, veinticuatro, veinticinco, veintiséis
    'veintisiete, veintiocho, veintinueve, treinta, treinta y uno, treinta y dos, cuarenta, cuarenta y uno
    'cincuenta, sesenta, setenta, ochenta, noventa
'centena: cien, ciento uno, ciento dos, doscientos, doscientos dos, trescientos, cuatrocientos, quinientos
    'seiscientos, setecientos, ochocientos, novecientos
 
 
 
'unidad de mil: mil, dos mil, tres mil, cuatro mil, cinco mil, seis mil, siete mil, ocho mil, nueve mil
'decena de mil: diez mil (10.000)
'centena de mil: cien mil (100.000), quinientos mil (500.000)
'unidad de millon?: un millón (1.000.000)---------------------------------DIE HERE
'decena de millon?: diez millones (10.000.000)
'centena de millon?: cien millones (100.000.000)
'mil millones (1.000.000.000)
'diez mil millones (10.000.000.000)
'cien mil millones (100.000.000.000)
'un billón (1.000.000.000.000)
 
'*Long (4) Números enteros en el rango de -2.147.483.648 a 2.147.483.647
 
'Se me fueron las ganas de hacer este programa, y solamente hice los comentarios...
 
'1226
'y que devuelva:
'mil doscientos veinte y seis.... -> mil doscientos veintiseis, lol, que ironía.
 
Public unidad(0 To 15) As String
Public Subunidad(0 To 10) As String
 
Public decena(0 To 9) As String
Public centena(0 To 9) As String
 
Public mil(0 To 9) As String
 
Sub Main()
Call Config
Form1.Show
End Sub
 
Public Sub Config()
Dim i As Byte
 
'#############################################################
                   '                DECENA(0,1,2,3)                                        CENTENA(4,5,6,7) ->                                  MIL(8,9)
unidad(0) = "cero": Subunidad(0) = ""
unidad(1) = "uno": Subunidad(1) = "on;die;ci;":             Subunidad(1) = Subunidad(1) & ";c;ien;;" ':           Subunidad(1) = Subunidad(1) & ";;mil"
unidad(2) = "dos": Subunidad(2) = "do;ve;int;":             Subunidad(2) = Subunidad(2) & ";c;ien;dos;tos" ':     Subunidad(2) = Subunidad(2) & ";dos ;mil"
unidad(3) = "tres": Subunidad(3) = "tre;tre;int;a":         Subunidad(3) = Subunidad(3) & ";c;ien;tres;tos" ':    Subunidad(3) = Subunidad(3) & ";tres ;mil"
unidad(4) = "cuatro": Subunidad(4) = "cator;cuar;ent;a":    Subunidad(4) = Subunidad(4) & ";c;ien;cuatro;tos" ':  Subunidad(4) = Subunidad(4) & ";cuatro ;mil"
unidad(5) = "cinco": Subunidad(5) = "quin;cincu;ent;a":     Subunidad(5) = Subunidad(5) & ";;ien;quin;tos" ':     Subunidad(5) = Subunidad(5) & ";cinco ;mil"
unidad(6) = "seis": Subunidad(6) = "ses;ses;ent;a":         Subunidad(6) = Subunidad(6) & ";c;ien;seis;tos" ':    Subunidad(6) = Subunidad(6) & ";seis ;mil"
unidad(7) = "siete": Subunidad(7) = "set;set;ent;a":        Subunidad(7) = Subunidad(7) & ";c;ien;sete;tos" ':    Subunidad(7) = Subunidad(7) & ";siete ;mil"
unidad(8) = "ocho": Subunidad(8) = "och;och;ent;a":         Subunidad(8) = Subunidad(8) & ";c;ien;ocho;tos" ':    Subunidad(8) = Subunidad(8) & ";ocho ;mil"
unidad(9) = "nueve": Subunidad(9) = "nov;nov;ent;a":        Subunidad(9) = Subunidad(9) & ";c;ien;nove;tos" ':    Subunidad(9) = Subunidad(9) & ";nueve ;mil"
unidad(10) = "diez" ': Subunidad(10) = "en;ento;tos;ien"
 
'Numeros molestos
'once, doce, trece, catorce, quince
'unidad(11) = "once" 'DEATH
For i = 1 To 5
    unidad(i + 10) = Split(Subunidad(i), ";")(0) & "ce"
Next i
'unidad(12) = "doce" 'DEATH
'unidad(13) = "trece" 'DEATH
'unidad(14) = "catorce" 'DEATH
'unidad(15) = "quince" 'DEATH
 
'#############################################################
 
For i = 1 To 9
    decena(i) = Split(Subunidad(i), ";")(1) & Split(Subunidad(i), ";")(2) & Split(Subunidad(i), ";")(3)
    'If i = 1 Then
    '    decena(i) = Split(Subunidad(i * 10), ";")(1) & "ci" 'dieci-séis, dieci-siete, dieci-ocho, dieci-nueve
    'Else
    '    decena(i) = Split(Subunidad(i * 10), ";")(1) & "int"
    '    If i > 2 Then decena(i) = decena(i) & "a"
    'End If
Next i
 
'decena(1) = Subunidad(10) & "ci" '>= 16 dieci-séis, dieci-siete, dieci-ocho, dieci-nueve
'decena(2) = "veint" 'veint e 20 / veint i 20+ +numero
''Acá puedo hacer lo mismo que abajo, hay un patrón para éstos números, pero mucho bardo
'decena(3) = "treinta" ' y +numero
'decena(4) = "cuarenta" ' y +numero
'decena(5) = "cincuenta" ' y +numero
'decena(6) = "sesenta" ' y +numero
'decena(7) = "setenta" ' y +numero
'decena(8) = "ochenta" ' y +numero
'decena(9) = "noventa" ' y +numero
'decena(10) = "cien"
 
'#############################################################
 
'centena(1) = "cien" ' +numero
For i = 1 To 9 '                                                        C                            IEN                           TOS
    centena(i) = Split(Subunidad(i), ";")(6) & Split(Subunidad(i), ";")(4) & Split(Subunidad(i), ";")(5) & Split(Subunidad(i), ";")(7)
Next i
'numero + cien + tos
'centena(2) = "doscientos"
'centena(3) = "trescientos"
'centena(4) = "cuatrocientos"
'centena(5) = "quinientos"
'centena(6) = "seiscientos"
'centena(7) = "setecientos"
'centena(8) = "ochocientos"
'centena(9) = "novecientos"
 
'#############################################################
 
'For i = 1 To 9 '                    NUM                          MIL
'    mil(i) = Split(Subunidad(i), ";")(8) & Split(Subunidad(i), ";")(9)
'Next i
End Sub
 
Public Function NumersToLetters(ByVal Number As Double) As String
On Local Error Resume Next
Dim u As Byte, d As Byte, c As Byte
 
Dim tLoop As Byte, Rta As String, cont As Byte
Dim partes(1 To 3) As String 'x millones + x miles + c + d + u
 
'u = Mid(StrReverse(Number), 1, 1)
'd = Mid(StrReverse(Number), 2, 1)
'c = Mid(StrReverse(Number), 3, 1)
'.
 
For tLoop = 1 To Len(CStr(Number))
    u = Mid(StrReverse(Number), tLoop, 1)
 
    If tLoop + 1 > Len(CStr(Number)) Then
        d = 0
    Else
        d = Mid(StrReverse(Number), tLoop + 1, 1)
    End If
 
    If tLoop + 2 > Len(CStr(Number)) Then
        c = 0
    Else
        c = Mid(StrReverse(Number), tLoop + 2, 1)
    End If
 
    Rta = Ret_C(c, d, u) & " " & Ret_DU(c, d, u, cont, Len(CStr(Number))) & " " & RetornarPunto(tLoop, c, d, u)
    tLoop = tLoop + 2
    cont = cont + 1
    partes(cont) = Rta
Next tLoop
 
'If Number > 1000000 Then
'    NumersToLetters = "Error, solo hasta 1 millon."
'    Exit Function
'End If
 
Dim p_d As String, p_c As String
 
'p_d = Ret_DU(c, d, u)
'p_c = Ret_C(c, d, u)
 
'NumersToLetters = p_c & " " & p_d
NumersToLetters = Trim(Trim(partes(3)) & " " & Trim(partes(2)) & IIf(Trim(partes(2)) <> "", " ", "") & Trim(partes(1)))
End Function
 
Public Function Ret_DU(ByVal c As Byte, ByVal d As Byte, ByVal u As Byte, ByVal Punto As Byte, ByVal Longitud As Byte) As String
If (c * 100) + (d * 10) + (u * 1) = 0 And Longitud < 4 Then
    Ret_DU = unidad(u)
    Exit Function
End If
Select Case d
    Case 0
        If Punto = 0 Then
            Ret_DU = IIf(u > 0, unidad(u), "")
        ElseIf Punto >= 1 Then
            If u = 1 Then
                Ret_DU = "un"
            Else
                Ret_DU = IIf(u > 1, unidad(u), "")
            End If
        End If
    Case 1
        Select Case (d * 10) + u
            Case 10
                Ret_DU = unidad((d * 10) + u)
            Case 11 To 15
                Ret_DU = unidad((d * 10) + u)
            Case Else
                Ret_DU = decena(1) & unidad(u)
        End Select
    Case 2
        Select Case (d * 10) + u
            Case 20
                Ret_DU = decena(2) & "e"
            Case Else
                Ret_DU = decena(2) & "i" & unidad(u)
        End Select
    Case Else
        'Ret_DU = decena(d) & IIf(u > 0, " y ", "") & IIf(u > 0, unidad(u), "")
        Ret_DU = decena(d) & IIf(u > 0, " y ", "") & IIf(u > 0, unidad(u), "")
        If Punto > 0 Then Ret_DU = Replace(Ret_DU, "uno", "un")
            'Esto es para q no diga 331123 - trescientos treinta y "uno" mil ciento veintitres
            'Muchas cosas que modifiké son este tipo de casos...
End Select
'diez
'once
'doce
'trece
'catorce
'quince
'dieci-seis
'dieci-siete
'dieci-ocho
'dieci-nueve
 
'veint-e
'veint-i-uno
'veint-i-dos
'veint-i-tres
'veint-i-cuatro
'veint-i-cinco
'veint-i-seis
'veint-i-siete
'veint-i-ocho
'veint-i-nueve
End Function
 
Public Function Ret_C(ByVal c As Byte, ByVal d As Byte, ByVal u As Byte) As String
Select Case c
    Case 1
        Select Case (d * 10) + u
            Case 0
                Ret_C = centena(c)
            Case Else
                Ret_C = centena(c) & "to"
        End Select
    Case Else
        Ret_C = centena(c)
End Select
End Function
 
Public Function RetornarPunto(ByVal tLoop As Byte, ByVal c As Byte, ByVal d As Byte, ByVal u As Byte) As String
Select Case tLoop
    Case 4
        RetornarPunto = IIf(c * 100 + d * 10 + u * 1 > 0, "mil", "")
    Case 7
        RetornarPunto = "millon" & IIf(c * 100 + d * 10 + u * 1 > 1, "es", "")
End Select
End Function