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 *-)
[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
Option Explicit
'----------------------------------------------------------------------------------------
' Module : NumbersToLetters
' Purpose : Numbers to letters
' Author : Misery / Kazuki_Paradox
' 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
Autor
En línea
, de lo contrario yo hubiera puesto completa la url a mi blog...
