Pasar numeros decimales a letras. |
Responder |
Autor | |
Antonio Pedro
Asiduo Unido: 13/Diciembre/2005 Estado: Sin conexión Puntos: 308 |
Opciones de entrada
Gracias(0)
Enviado: 05/Junio/2023 a las 15:20 |
Un Saludo.
Estoy pasando números decimales a letras, más concretamente los números comprendidos entre el 0,60 al 2,10, con una instrucción de Neckkito, la cual he adaptado a mis necesidades y me funciona bien, pero cuando llego al 1,10 ya no me va tan bien, es decir con la instrucción me sale UNO COMA CERO DIEZ, cuando me debería de salir UNO COMA DIEZ y a partir de esa cifra ya no salen bien el paso a letras, por ejemplo pongo 1,55 y sale UNO COMA CERO CINCUENTA Y CINCO. He estado modificando la instrucción, pero no doy con la tecla. Que debería de modificar en la instrucción, para que a partir de ese número 1,10 me saliera correctamente. Adjunto la instrucción que estoy utilizando y modificada a mis necesidades. Public Function num2let(ByVal value As Double, Optional vCurr As String)
As String Dim vDec As String vDec =
Num2Text(Int(Round((value - Int(value)) * 100))) If vDec = "CERO"
Then If Int(value) = 1 Then num2let =
"UNO" & " COMA " & " CERO " & vDec
& " " & UCase(vCurr) Else num2let = Num2Text(Int(value)) & "
" & UCase(vCurr) End If Else If Int(value) = 1 Then num2let =
"UNO" & " COMA " & " CERO " & vDec
& " " & UCase(vCurr) Else num2let =
Num2Text(Int(value)) & " COMA " & vDec & " "
& UCase(vCurr) End If End If End Function Public Function Num2Text(ByVal value As Double) As String Select Case value Case 0: Num2Text =
"CERO" Case 1: Num2Text =
"UNO" Case 2: Num2Text =
"DOS" Case 3: Num2Text = "TRES" Case 4: Num2Text =
"CUATRO" Case 5: Num2Text =
"CINCO" Case 6: Num2Text =
"SEIS" Case 7: Num2Text =
"SIETE" Case 8: Num2Text =
"OCHO" Case 9: Num2Text =
"NUEVE" Case 10: Num2Text =
"DIEZ" Case 11: Num2Text =
"ONCE" Case 12: Num2Text =
"DOCE" Case 13: Num2Text =
"TRECE" Case 14: Num2Text =
"CATORCE" Case 15: Num2Text =
"QUINCE" Case Is < 20: Num2Text
= "DIECI" & Num2Text(value - 10) Case 20: Num2Text =
"VEINTE" Case Is < 30: Num2Text
= "VEINTI" & Num2Text(value - 20) Case 30: Num2Text =
"TREINTA" Case 40: Num2Text =
"CUARENTA" Case 50: Num2Text =
"CINCUENTA" Case 60: Num2Text =
"SESENTA" Case 70: Num2Text =
"SETENTA" Case 80: Num2Text =
"OCHENTA" Case 90: Num2Text =
"NOVENTA" Case Is < 100:
Num2Text = Num2Text(Int(value \ 10) * 10) & " Y " &
Num2Text(value Mod 10) Case 100: Num2Text =
"CIEN" End Select
|
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
Opciones de entrada
Gracias(0)
|
Ummmm Es esta la función de Neckkito ? La función original de Neckkito No funciona ? |
|
Antonio Pedro
Asiduo Unido: 13/Diciembre/2005 Estado: Sin conexión Puntos: 308 |
Opciones de entrada
Gracias(0)
|
Hola, la función que he puesto por lo menos a mi me hace lo que deseo (me funciona), lo único que como dije al llegar al 1,10 no me pone la cifra correctamente en letras.
|
|
Antonio Pedro
Asiduo Unido: 13/Diciembre/2005 Estado: Sin conexión Puntos: 308 |
Opciones de entrada
Gracias(0)
|
Como continuacion, se me habia pasado, en un formulario tengo dos textbox (Texto30, TxtLetras) con la siguiente instrucción:
Private Sub Texto30_LostFocus() Dim vImp As Variant, vImpLet As String vImp = Me.Texto30.value ' 'Si el importe estuviera en blanco borra valores, si los hubiera, y sale del proceso If IsNull(vImp) Then Me.TxtLetras.value = Null Exit Sub End If 'Convertimos el importe a letras a través de la función vImpLet = num2let(vImp) 'Asignamos el valor obtenido a nuestro cuadro de texto Me.TxtLetras.value = vImpLet End Sub Lo completo al mensaje inicial, por si sirviera de algo. Saludos.
|
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
Opciones de entrada
Gracias(0)
|
Buenas Cambia la funcion num2let por esta otra Public Function num2let(ByVal value As Double, Optional vCurr As String) As String Dim vDec As String vDec = Num2Text(Int(Round((value - Int(value)) * 100))) If vDec = "CERO" Then If Int(value) = 1 Then num2let = "UNO" & " COMA " & " CERO " & vDec & " " & UCase(vCurr) Else num2let = Num2Text(Int(value)) & " " & UCase(vCurr) End If Else If Int(value) = 1 Then num2let = "UNO" & " COMA " & vDec & " " & UCase(vCurr) Else num2let = Num2Text(Int(value)) & " COMA " & vDec & " " & UCase(vCurr) End If End If End Function |
|
Antonio Pedro
Asiduo Unido: 13/Diciembre/2005 Estado: Sin conexión Puntos: 308 |
Opciones de entrada
Gracias(0)
|
Hola Javier, Y gracias por tu ayuda. He cambiado la instrucción que me has enviado, pero no hace lo que deseo, es
decir con la anterior instrucción ponía 1,01 y me escribía UNO COMA CERO UNO, así
hasta el UNO COMA DIEZ, a partir de ahí, cuando escribo 1,10 me escribe UNO
COMA CERO DIEZ. Con la instrucción
que me indicas, si pongo: 1,01 me
escribe UNO COMA UNO, 1,02 UNO COMA DOS, 1,03 UNO COMA TRES, 1,04 UNO COMA
CUATRO, etc..., así hasta el 1,09. A partir del 1,10 me escribe bien UNO COMA DIEZ. Pero con tu nueva instrucción desde el 1,01 hasta
1,09 no lo escribe bien. Es en ese intervalo donde estoy atascado. Espero que
no parezca esto muy lioso. Saludos |
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
Opciones de entrada
Gracias(0)
|
Un pregunta: El valor de 1 como debería ser ? 1,00 = UNO ? o bien 1,00 = UNO COMA CERO CERO ? Cual de los dos es la opción correcta ? La parte decimal puede tener mas de 2 dígitos ?? Puedes poner mas números validos para ti ? Editado por javier.mil - 06/Junio/2023 a las 14:07 |
|
Antonio Pedro
Asiduo Unido: 13/Diciembre/2005 Estado: Sin conexión Puntos: 308 |
Opciones de entrada
Gracias(0)
|
Hola,
1.- La opción correcta 1,00 UNO COMA CERO CERO 2.- La parte decimal es de dos dígitos 3.- Números comprendidos entre el 0,60 al 2,10 Saludos.
|
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
Opciones de entrada
Gracias(0)
|
Buenas A ver si te sirve esta funcion , con muy pocas modificaciones podras hacer lo que necesitas Para testear ponlo en cualquier parte del programa Private Function funTest() Dim dblX As Double Rem Números comprendidos entre el 0,60 al 2,10 dblX = 0.6 Do Until dblX >= 2.1 Debug.Print Format(dblX, "##,##0.00") & " = " & funConversorNum(dblX) dblX = dblX + 0.01 Loop MsgBox "FIN" End Function Ponlo en un MODULO standard Public Function funConversorNum(ByVal PonNumero As Double) As String Rem www.accessdemo.info Dim intX As Integer Dim intMax As Integer Dim strResultado As String Dim strTexto As String Dim strDigito As String For intX = 1 To Len(CStr(PonNumero)) strDigito = Mid$(PonNumero, intX, 1) Select Case strDigito Case 0: strTexto = Replace(strDigito, "0", "CERO ") Case 1: strTexto = Replace(strDigito, "1", "UNO ") Case 2: strTexto = Replace(strDigito, "2", "DOS ") Case 3: strTexto = Replace(strDigito, "3", "TRES ") Case 4: strTexto = Replace(strDigito, "4", "CUATRO ") Case 5: strTexto = Replace(strDigito, "5", "CINCO ") Case 6: strTexto = Replace(strDigito, "6", "SEIS ") Case 7: strTexto = Replace(strDigito, "7", "SIETE ") Case 8: strTexto = Replace(strDigito, "8", "OCHO ") Case 9: strTexto = Replace(strDigito, "9", "NUEVE ") Case ",": strTexto = Replace(strDigito, ",", "COMA ") End Select strResultado = strResultado & strTexto Next funConversorNum = strResultado End Function +++++++++++ El resultado seria asi: 0,60 = CERO COMA SEIS 0,61 = CERO COMA SEIS UNO 0,62 = CERO COMA SEIS DOS 0,63 = CERO COMA SEIS TRES 0,64 = CERO COMA SEIS CUATRO 0,65 = CERO COMA SEIS CINCO 0,66 = CERO COMA SEIS SEIS 0,67 = CERO COMA SEIS SIETE 0,68 = CERO COMA SEIS OCHO 0,69 = CERO COMA SEIS NUEVE 0,70 = CERO COMA SIETE 0,71 = CERO COMA SIETE UNO 0,72 = CERO COMA SIETE DOS 0,73 = CERO COMA SIETE TRES 0,74 = CERO COMA SIETE CUATRO 0,75 = CERO COMA SIETE CINCO 0,76 = CERO COMA SIETE SEIS 0,77 = CERO COMA SIETE SIETE 0,78 = CERO COMA SIETE OCHO 0,79 = CERO COMA SIETE NUEVE 0,80 = CERO COMA OCHO 0,81 = CERO COMA OCHO UNO 0,82 = CERO COMA OCHO DOS 0,83 = CERO COMA OCHO TRES 0,84 = CERO COMA OCHO CUATRO 0,85 = CERO COMA OCHO CINCO 0,86 = CERO COMA OCHO SEIS 0,87 = CERO COMA OCHO SIETE 0,88 = CERO COMA OCHO OCHO 0,89 = CERO COMA OCHO NUEVE 0,90 = CERO COMA NUEVE 0,91 = CERO COMA NUEVE UNO 0,92 = CERO COMA NUEVE DOS 0,93 = CERO COMA NUEVE TRES 0,94 = CERO COMA NUEVE CUATRO 0,95 = CERO COMA NUEVE CINCO 0,96 = CERO COMA NUEVE SEIS 0,97 = CERO COMA NUEVE SIETE 0,98 = CERO COMA NUEVE OCHO 0,99 = CERO COMA NUEVE NUEVE 1,00 = UNO 1,01 = UNO COMA CERO UNO 1,02 = UNO COMA CERO DOS 1,03 = UNO COMA CERO TRES 1,04 = UNO COMA CERO CUATRO 1,05 = UNO COMA CERO CINCO 1,06 = UNO COMA CERO SEIS 1,07 = UNO COMA CERO SIETE 1,08 = UNO COMA CERO OCHO 1,09 = UNO COMA CERO NUEVE 1,10 = UNO COMA UNO 1,11 = UNO COMA UNO UNO 1,12 = UNO COMA UNO DOS 1,13 = UNO COMA UNO TRES 1,14 = UNO COMA UNO CUATRO 1,15 = UNO COMA UNO CINCO 1,16 = UNO COMA UNO SEIS 1,17 = UNO COMA UNO SIETE 1,18 = UNO COMA UNO OCHO 1,19 = UNO COMA UNO NUEVE 1,20 = UNO COMA DOS 1,21 = UNO COMA DOS UNO 1,22 = UNO COMA DOS DOS 1,23 = UNO COMA DOS TRES 1,24 = UNO COMA DOS CUATRO 1,25 = UNO COMA DOS CINCO 1,26 = UNO COMA DOS SEIS 1,27 = UNO COMA DOS SIETE 1,28 = UNO COMA DOS OCHO 1,29 = UNO COMA DOS NUEVE 1,30 = UNO COMA TRES 1,31 = UNO COMA TRES UNO 1,32 = UNO COMA TRES DOS 1,33 = UNO COMA TRES TRES 1,34 = UNO COMA TRES CUATRO 1,35 = UNO COMA TRES CINCO 1,36 = UNO COMA TRES SEIS 1,37 = UNO COMA TRES SIETE 1,38 = UNO COMA TRES OCHO 1,39 = UNO COMA TRES NUEVE 1,40 = UNO COMA CUATRO 1,41 = UNO COMA CUATRO UNO 1,42 = UNO COMA CUATRO DOS 1,43 = UNO COMA CUATRO TRES 1,44 = UNO COMA CUATRO CUATRO 1,45 = UNO COMA CUATRO CINCO 1,46 = UNO COMA CUATRO SEIS 1,47 = UNO COMA CUATRO SIETE 1,48 = UNO COMA CUATRO OCHO 1,49 = UNO COMA CUATRO NUEVE 1,50 = UNO COMA CINCO 1,51 = UNO COMA CINCO UNO 1,52 = UNO COMA CINCO DOS 1,53 = UNO COMA CINCO TRES 1,54 = UNO COMA CINCO CUATRO 1,55 = UNO COMA CINCO CINCO 1,56 = UNO COMA CINCO SEIS 1,57 = UNO COMA CINCO SIETE 1,58 = UNO COMA CINCO OCHO 1,59 = UNO COMA CINCO NUEVE 1,60 = UNO COMA SEIS 1,61 = UNO COMA SEIS UNO 1,62 = UNO COMA SEIS DOS 1,63 = UNO COMA SEIS TRES 1,64 = UNO COMA SEIS CUATRO 1,65 = UNO COMA SEIS CINCO 1,66 = UNO COMA SEIS SEIS 1,67 = UNO COMA SEIS SIETE 1,68 = UNO COMA SEIS OCHO 1,69 = UNO COMA SEIS NUEVE 1,70 = UNO COMA SIETE 1,71 = UNO COMA SIETE UNO 1,72 = UNO COMA SIETE DOS 1,73 = UNO COMA SIETE TRES 1,74 = UNO COMA SIETE CUATRO 1,75 = UNO COMA SIETE CINCO 1,76 = UNO COMA SIETE SEIS 1,77 = UNO COMA SIETE SIETE 1,78 = UNO COMA SIETE OCHO 1,79 = UNO COMA SIETE NUEVE 1,80 = UNO COMA OCHO 1,81 = UNO COMA OCHO UNO 1,82 = UNO COMA OCHO DOS 1,83 = UNO COMA OCHO TRES 1,84 = UNO COMA OCHO CUATRO 1,85 = UNO COMA OCHO CINCO 1,86 = UNO COMA OCHO SEIS 1,87 = UNO COMA OCHO SIETE 1,88 = UNO COMA OCHO OCHO 1,89 = UNO COMA OCHO NUEVE 1,90 = UNO COMA NUEVE 1,91 = UNO COMA NUEVE UNO 1,92 = UNO COMA NUEVE DOS 1,93 = UNO COMA NUEVE TRES 1,94 = UNO COMA NUEVE CUATRO 1,95 = UNO COMA NUEVE CINCO 1,96 = UNO COMA NUEVE SEIS 1,97 = UNO COMA NUEVE SIETE 1,98 = UNO COMA NUEVE OCHO 1,99 = UNO COMA NUEVE NUEVE 2,00 = DOS 2,01 = DOS COMA CERO UNO 2,02 = DOS COMA CERO DOS 2,03 = DOS COMA CERO TRES 2,04 = DOS COMA CERO CUATRO 2,05 = DOS COMA CERO CINCO 2,06 = DOS COMA CERO SEIS 2,07 = DOS COMA CERO SIETE 2,08 = DOS COMA CERO OCHO 2,09 = DOS COMA CERO NUEVE 2,10 = DOS COMA UNO Editado por javier.mil - 06/Junio/2023 a las 22:37 |
|
Antonio Pedro
Asiduo Unido: 13/Diciembre/2005 Estado: Sin conexión Puntos: 308 |
Opciones de entrada
Gracias(0)
|
Hola Javier y gracias por tu tiempo, pero no es eso lo que estoy buscando.
El poner los valores entre 0,60 y 2,10 es el resultado de una prueba. Cuando el resultado da por ejemplo 0,94 lo que busco es que ponga CERO COMA NOVENTA Y CUATRO o por ejemplo 1,86 UNO COMA OCHETA Y SEIS y no como me indicas CERO COMA NUEVE CUATRO, o UNO COMA OCHO SEIS, Saludos y gracias.
|
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
Opciones de entrada
Gracias(0)
|
Hola Antonio Pedro He fusionado la rutina de Neckkito con la mia La función nueva que fusiona ambas rutinas (la de Neckkito y la mia) ahora se llama funNumToLetters Lógicamente ahora No esta optimizada y se podría mejorar,........ mirala a ver si te sirve ,....... He visto algún resultado "raro" pero quizás para el rango que tu necesitas te podría funcionar ,....... Public Function funNumToLetters(PonValor As Double, Optional PonDivisa As String) As String Rem Conversion de Numeros a Letras Version 2 Dim strDec As String Dim dblValDec As Double dblValDec = PonValor - Int(PonValor) If dblValDec >= 0 And dblValDec < 0.1 Then funNumToLetters = funJavier(PonValor) & " " & UCase(PonDivisa) Else strDec = funNeckkito(Int(Round((PonValor - Int(PonValor)) * 100))) If strDec = "CERO" Then If Int(PonValor) = 1 Then funNumToLetters = "UNO" & " COMA " & " CERO " & strDec & " " & UCase(PonDivisa) Else funNumToLetters = funNeckkito(Int(PonValor)) & " " & UCase(PonDivisa) End If Else If Int(PonValor) = 1 Then funNumToLetters = "UNO" & " COMA " & strDec & " " & UCase(PonDivisa) Else funNumToLetters = funNeckkito(Int(PonValor)) & " COMA " & strDec & " " & UCase(PonDivisa) End If End If End If End Function Private Function funNeckkito(PonValor As Double) As String Select Case PonValor Case 0: funNeckkito = "CERO" Case 1: funNeckkito = "UNO" Case 2: funNeckkito = "DOS" Case 3: funNeckkito = "TRES" Case 4: funNeckkito = "CUATRO" Case 5: funNeckkito = "CINCO" Case 6: funNeckkito = "SEIS" Case 7: funNeckkito = "SIETE" Case 8: funNeckkito = "OCHO" Case 9: funNeckkito = "NUEVE" Case 10: funNeckkito = "DIEZ" Case 11: funNeckkito = "ONCE" Case 12: funNeckkito = "DOCE" Case 13: funNeckkito = "TRECE" Case 14: funNeckkito = "CATORCE" Case 15: funNeckkito = "QUINCE" Case Is < 20: funNeckkito = "DIECI" & funNeckkito(PonValor - 10) Case 20: funNeckkito = "VEINTE" Case Is < 30: funNeckkito = "VEINTI" & funNeckkito(PonValor - 20) Case 30: funNeckkito = "TREINTA" Case 40: funNeckkito = "CUARENTA" Case 50: funNeckkito = "CINCUENTA" Case 60: funNeckkito = "SESENTA" Case 70: funNeckkito = "SETENTA" Case 80: funNeckkito = "OCHENTA" Case 90: funNeckkito = "NOVENTA" Case Is < 100: funNeckkito = funNeckkito(Int(PonValor \ 10) * 10) & " Y " & funNeckkito(PonValor Mod 10) Case 100: funNeckkito = "CIEN" End Select End Function Private Function funJavier(PonNumero As Double) As String Rem www.accessdemo.info Dim intX As Integer Dim strResultado As String Dim strTexto As String Dim strDigito As String For intX = 1 To Len(CStr(PonNumero)) strDigito = Mid$(PonNumero, intX, 1) Select Case strDigito Case 0: strTexto = Replace(strDigito, "0", "CERO ") Case 1: strTexto = Replace(strDigito, "1", "UNO ") Case 2: strTexto = Replace(strDigito, "2", "DOS ") Case 3: strTexto = Replace(strDigito, "3", "TRES ") Case 4: strTexto = Replace(strDigito, "4", "CUATRO ") Case 5: strTexto = Replace(strDigito, "5", "CINCO ") Case 6: strTexto = Replace(strDigito, "6", "SEIS ") Case 7: strTexto = Replace(strDigito, "7", "SIETE ") Case 8: strTexto = Replace(strDigito, "8", "OCHO ") Case 9: strTexto = Replace(strDigito, "9", "NUEVE ") Case ",": strTexto = Replace(strDigito, ",", "COMA ") End Select strResultado = strResultado & strTexto Next funJavier = strResultado End Function |
|
Juanmasp
Habitual Unido: 21/Abril/2006 Estado: Sin conexión Puntos: 118 |
Opciones de entrada
Gracias(0)
|
Hola, creo que os estais complicando, si ya casi estaba.
Con la rutina inicial, lo puedes hacer así: Public Function num2let(ByVal value As Double, Optional vCurr As String) As String Dim iDec As Integer iDec = Int(Round((value - Int(value)) * 100)) If iDec <10 Then num2let = Num2Text(Int(value)) & " COMA CERO " & Num2Text(IDec) & " " & UCase(vCurr) Else num2let = Num2Text(Int(value)) & " COMA " & Num2Text(IDec) & " " & UCase(vCurr) End If End Function Convertimos la parte entera y la parte decimal, y le añadimos el CERO adicional si es necesario. Salu2 |
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
Opciones de entrada
Gracias(0)
|
Fantastico Juanmasp !! Solo comentar que a`partir de un numero superior a 101 el resultado es erróneo pero creo que el resto de casos cumple con lo que se pedia Editado por javier.mil - 07/Junio/2023 a las 18:02 |
|
Antonio Pedro
Asiduo Unido: 13/Diciembre/2005 Estado: Sin conexión Puntos: 308 |
Opciones de entrada
Gracias(0)
|
¡¡¡Muchísimas gracias!!!, tanto a Javier como a Juanmasp por el interés, al final la función de Juanmasp me ha servido. Lo dicho gracias. Se puede cerrar el hilo.
Saludos
|
|
javier.mil
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 10/Agosto/2005 Localización: España Estado: Sin conexión Puntos: 4812 |
Opciones de entrada
Gracias(0)
|
Buenas , he solicitado re-abrir este hilo para poder incluir el código mejorado y ahora limitado hasta una cifra de 10 Millones Public Function funNum2Let(ByVal PonValor As Double, Optional PonDivisa As String) As String Rem Autor Original: Neckkito Rem Autor Modificaciones Uno: Juanmasp Rem Autor Modificaciones Dos: Javier.Mil >> https://www.accessdemo.info/ Rem Rutina Principal . Rem Uso funNum2Let (Pon Numero Aqui) Const cValorMax = 10 ^ 7 ' << Valor maximo: 10 Millones Dim iintDec As Integer Dim strTemp_1 As String Dim strTemp_2 As String Dim strTemp_3 As String If PonValor > cValorMax Then MsgBox "Error: El programa No puede calcular numeros superiores a: " & cValorMax, vbExclamation, "Error" funNum2Let = "Error" Exit Function End If iintDec = Int(Round((PonValor - Int(PonValor)) * 100)) If (PonValor - Int(PonValor)) * 100 = 0 Then strTemp_1 = Trim(Replace(funNum2Text(Int(PonValor)), " ", " ")) If Right(strTemp_1, 2) = "UN" Then Rem Si el ultimo digito es un 1 sustituyo el "UN" por "UNO" funNum2Let = Trim(strTemp_1 & "O " & UCase(PonDivisa)) Else funNum2Let = Trim(strTemp_1 & " " & UCase(PonDivisa)) End If Else strTemp_2 = Trim(Replace(funNum2Text(Int(PonValor)), " ", " ")) If Right(strTemp_2, 2) = "UN" Then Rem Si el ultimo digito es un 1 sustituyo el "UN" por "UNO" strTemp_2 = Trim(strTemp_2 & "O " & UCase(PonDivisa)) Else strTemp_2 = Trim(strTemp_2 & " " & UCase(PonDivisa)) End If strTemp_3 = Trim(Replace(Trim(Replace(funNum2Text(Int(iintDec)), " ", " ")), "UN", "UNO")) If iintDec < 10 Then funNum2Let = strTemp_2 & " COMA CERO " & strTemp_3 & " " & UCase(PonDivisa) Else funNum2Let = strTemp_2 & " COMA " & strTemp_3 & " " & UCase(PonDivisa) End If End If End Function Private Function funNum2Text(ByVal PonNumero As Double) As String Rem Autor Original: Neckkito Rem Autor Modificaciones Javier.Mil >> https://www.accessdemo.info/ Rem Ahora permite convertir cualquier numero desde el 0 hasta 10 Millones con 2 decimales Rem AVISO: si se cambia el orden de los CASE puede afectar al resultado Rem: Rutina Secundaria Select Case PonNumero Rem Calculo desde el CERO hasta CIEN Case 0: funNum2Text = "CERO" Case 1: funNum2Text = "UN" ' << al final sustituyo el "UN" por "UNO" Case 2: funNum2Text = "DOS" Case 3: funNum2Text = "TRES" Case 4: funNum2Text = "CUATRO" Case 5: funNum2Text = "CINCO" Case 6: funNum2Text = "SEIS" Case 7: funNum2Text = "SIETE" Case 8: funNum2Text = "OCHO" Case 9: funNum2Text = "NUEVE" Case 10: funNum2Text = "DIEZ" Case 11: funNum2Text = "ONCE" Case 12: funNum2Text = "DOCE" Case 13: funNum2Text = "TRECE" Case 14: funNum2Text = "CATORCE" Case 15: funNum2Text = "QUINCE" Case 16 To 19.99: funNum2Text = "DIECI" & funNum2Text(PonNumero - 10) Case 20: funNum2Text = "VEINTE" Case 21 To 29.99: funNum2Text = "VEINTI" & funNum2Text(PonNumero - 20) Case 30: funNum2Text = "TREINTA" Case 40: funNum2Text = "CUARENTA" Case 50: funNum2Text = "CINCUENTA" Case 60: funNum2Text = "SESENTA" Case 70: funNum2Text = "SETENTA" Case 80: funNum2Text = "OCHENTA" Case 90: funNum2Text = "NOVENTA" Case 0.01 To 99.99: funNum2Text = funNum2Text(Int(PonNumero \ 10) * 10) & " Y " & funNum2Text(PonNumero Mod 10) Rem Calculo desde el CIEN hasta MIL Case 100: funNum2Text = "CIEN" Case 101 To 199.99: funNum2Text = "CIENTO " & funNum2Text(PonNumero Mod 10 ^ 2) Case 500 To 599.99: funNum2Text = "QUINIENTOS " & IIf(PonNumero Mod 10 ^ 2 = 0, "", funNum2Text(PonNumero Mod 10 ^ 2)) Case 700 To 799.99: funNum2Text = "SETECIENTOS " & IIf(PonNumero Mod 10 ^ 2 = 0, "", funNum2Text(PonNumero Mod 10 ^ 2)) Case 200 To 899.99: funNum2Text = funNum2Text(Int(PonNumero \ 10 ^ 2)) & "CIENTOS " & IIf(PonNumero Mod 10 ^ 2 = 0, "", funNum2Text(PonNumero Mod 10 ^ 2)) Case 900 To 999.99: funNum2Text = "NOVECIENTOS " & IIf(PonNumero Mod 10 ^ 2 = 0, "", funNum2Text(PonNumero Mod 10 ^ 2)) Rem Calculo desde el MIL hasta UN MILLON Rem evito error de "UNO MIL...." Case 1000 To 1999.99: funNum2Text = "MIL " & IIf(PonNumero Mod 10 ^ 3 = 0, "", funNum2Text(PonNumero Mod 10 ^ 3)) Case 2000 To 999999.99: funNum2Text = funNum2Text(Int(PonNumero \ 10 ^ 3)) & " MIL " & IIf(PonNumero Mod 10 ^ 3 = 0, "", funNum2Text(PonNumero Mod 10 ^ 3)) Rem Calculo desde UN MILLON hasta DIEZ MILLONES Case 1000000 To 1009999.99: funNum2Text = "UN MILLON " & IIf(PonNumero Mod 10 ^ 4 = 0, "", funNum2Text(PonNumero Mod 10 ^ 4)) Case 1010000 To 1099999.99: funNum2Text = "UN MILLON " & IIf(PonNumero Mod 10 ^ 5 = 0, "", funNum2Text(PonNumero Mod 10 ^ 5)) Case 1100000 To 1999999.99: funNum2Text = "UN MILLON " & IIf(PonNumero Mod 10 ^ 6 = 0, "", funNum2Text(PonNumero Mod 10 ^ 6)) Case 1200000 To 9999999.99: funNum2Text = funNum2Text(Int(PonNumero \ 10 ^ 6)) & " MILLONES " & IIf(PonNumero Mod 10 ^ 6 = 0, "", funNum2Text(PonNumero Mod 10 ^ 6)) Case 10000000: funNum2Text = "DIEZ MILLONES" Case Else: MsgBox "Error numero= " & PonNumero, vbExclamation, "Error" End Select End Function Para poder testear el código Option Explicit Const cInicio = 0 Const cFin = 101 Const cIncremento = 0.01 Private Function funTest_1() Dim curX As Currency curX = cInicio Do Until curX > cFin Debug.Print curX & " = " & funNum2Let(curX) curX = curX + cIncremento Loop MsgBox "FIN" End Function Editado por javier.mil - 23/Junio/2023 a las 10:09 |
|
Responder | |
Tweet
|
Ir al foro | Permisos de foro Usted No puede publicar nuevos temas en este foro Usted No puede responder a temas en este foro Usted No puede borrar sus mensajes en este foro Usted No puede editar sus mensajes en este foro Usted No puede crear encuestas en este foro Usted No puede votar en encuestas en este foro |