** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Pasar numeros decimales a letras.
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Pasar numeros decimales a letras.

 Responder Responder
Autor
Mensaje
Antonio Pedro Ver desplegable
Asiduo
Asiduo


Unido: 13/Diciembre/2005
Estado: Sin conexión
Puntos: 308
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Antonio Pedro Cita  ResponderRespuesta Enlace directo a este mensaje Tema: Pasar numeros decimales a letras.
    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


 


Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita javier.mil Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 05/Junio/2023 a las 16:34
Ummmm
Es esta la función de Neckkito ? 
La función original de Neckkito No funciona ?

Arriba
Antonio Pedro Ver desplegable
Asiduo
Asiduo


Unido: 13/Diciembre/2005
Estado: Sin conexión
Puntos: 308
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Antonio Pedro Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 05/Junio/2023 a las 22:10
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.

Arriba
Antonio Pedro Ver desplegable
Asiduo
Asiduo


Unido: 13/Diciembre/2005
Estado: Sin conexión
Puntos: 308
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Antonio Pedro Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 05/Junio/2023 a las 22:34
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.
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita javier.mil Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 05/Junio/2023 a las 23:01
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


Arriba
Antonio Pedro Ver desplegable
Asiduo
Asiduo


Unido: 13/Diciembre/2005
Estado: Sin conexión
Puntos: 308
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Antonio Pedro Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 06/Junio/2023 a las 00:01

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

Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita javier.mil Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 06/Junio/2023 a las 14:04
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
Arriba
Antonio Pedro Ver desplegable
Asiduo
Asiduo


Unido: 13/Diciembre/2005
Estado: Sin conexión
Puntos: 308
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Antonio Pedro Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 06/Junio/2023 a las 21:35
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.
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita javier.mil Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 06/Junio/2023 a las 22:35
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
Arriba
Antonio Pedro Ver desplegable
Asiduo
Asiduo


Unido: 13/Diciembre/2005
Estado: Sin conexión
Puntos: 308
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Antonio Pedro Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 07/Junio/2023 a las 00:23
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.
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita javier.mil Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 07/Junio/2023 a las 11:52
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

 
Arriba
Juanmasp Ver desplegable
Habitual
Habitual


Unido: 21/Abril/2006
Estado: Sin conexión
Puntos: 118
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Juanmasp Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 07/Junio/2023 a las 14:56
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

Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita javier.mil Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 07/Junio/2023 a las 18:01
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
Arriba
Antonio Pedro Ver desplegable
Asiduo
Asiduo


Unido: 13/Diciembre/2005
Estado: Sin conexión
Puntos: 308
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Antonio Pedro Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 07/Junio/2023 a las 22:24
¡¡¡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

 
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4812
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita javier.mil Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 23/Junio/2023 a las 09:56
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
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable