Convertir números a letras en Access

Recopilación de varias funciones para convertir números a letras con Microsoft Access, muy útil para cheques.

Trucos para Microsoft Access

Os ofrecemos varias funciones para convertir números a letras con Access, muy útil para, por ejemplo, imprimir cheques partiendo de números, aunque tiene otras muchas aplicaciones:

Function letra(Numero)
Dim Texto
Dim Millones
Dim Miles
Dim Cientos
Dim Decimales
Dim Cadena
Dim CadMillones
Dim CadMiles
Dim CadCientos
Dim caddecimales
Texto = Round(Numero, 2)
Texto = FormatNumber(Texto, 2)
Texto = Right(Space(14) & Texto, 14)
Millones = Mid(Texto, 1, 3)
Miles = Mid(Texto, 5, 3)
Cientos = Mid(Texto, 9, 3)
Decimales = Mid(Texto, 13, 2)
CadMillones = ConvierteCifra(Millones, False)
CadMiles = ConvierteCifra(Miles, False)
CadCientos = ConvierteCifra(Cientos, True)
caddecimales = ConvierteDecimal(Decimales)

If Trim(CadMillones) > "" Then
If Trim(CadMillones) = "Un" Then
Cadena = CadMillones & " Millón"
Else
Cadena = CadMillones & " Millones"
End If
End If

If Trim(CadMiles) > "" Then
If Trim(CadMiles) = "Un" Then
CadMiles = ""
Cadena = Cadena & "" & CadMiles & "Mil"
CadMiles = "Un"
Else
Cadena = Cadena & " " & CadMiles & " Mil"
End If
End If
If Trim(CadMiles) > "001" Then
CadMiles = "Mil"
End If

If Decimales = "00" Then
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "Un" Then
Cadena = Cadena & "Uno "
Else
If Miles & Cientos = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos)
Else
Cadena = Cadena & " " & Trim(CadCientos)
End If
letra = Trim(Cadena)
End If
Else
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "Un" Then
Cadena = Cadena & "Uno " & "Con " & Trim(caddecimales)
Else
If Millones & Miles & Cientos & Decimales = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos) & " " & Trim(Decimales) & "/100 Nuevos Soles"
'Cadena = Cadena & " " & Trim(CadCientos) & " PESOS " & Trim(Decimales) & "/100 M.N."
Else
Cadena = Cadena & " " & Trim(CadCientos) & " " & Trim(Decimales) & "/100 Nuevos Soles"
'Cadena = Cadena & " " & Trim(CadCientos) & " PESOS " & Trim(Decimales) & "/100 M.N."
End If
letra = Trim(Cadena)
End If
End If

End Function

Function ConvierteCifra(Texto, IsCientos As Boolean)
Dim Centena
Dim Decena
Dim Unidad
Dim txtCentena
Dim txtDecena
Dim txtUnidad
Centena = Mid(Texto, 1, 1)
Decena = Mid(Texto, 2, 1)
Unidad = Mid(Texto, 3, 1)
Select Case Centena
Case "1"
txtCentena = "Cien"
If Decena & Unidad <> "00" Then
txtCentena = "Ciento"
End If
Case "2"
txtCentena = "Doscientos"
Case "3"
txtCentena = "Trescientos"
Case "4"
txtCentena = "Cuatrocientos"
Case "5"
txtCentena = "Quinientos"
Case "6"
txtCentena = "Seiscientos"
Case "7"
txtCentena = "Setecientos"
Case "8"
txtCentena = "Ochocientos"
Case "9"
txtCentena = "Novecientos"
End Select

Select Case Decena
Case "1"
txtDecena = "Diez"
Select Case Unidad
Case "1"
txtDecena = "Once"
Case "2"
txtDecena = "Doce"
Case "3"
txtDecena = "Trece"
Case "4"
txtDecena = "Catorce"
Case "5"
txtDecena = "Quince"
Case "6"
txtDecena = "Dieciseis"
Case "7"
txtDecena = "Diecisiete"
Case "8"
txtDecena = "Dieciocho"
Case "9"
txtDecena = "Diecinueve"
End Select
Case "2"
txtDecena = "Veinte"
If Unidad <> "0" Then
txtDecena = "Veinti"
End If
Case "3"
txtDecena = "Treinta"
If Unidad <> "0" Then
txtDecena = "Treinta y "
End If
Case "4"
txtDecena = "Cuarenta"
If Unidad <> "0" Then
txtDecena = "Cuarenta y "
End If
Case "5"
txtDecena = "Cincuenta"
If Unidad <> "0" Then
txtDecena = "Cincuenta y "
End If
Case "6"
txtDecena = "Sesenta"

If Unidad <> "0" Then
txtDecena = "Sesenta y "
End If
Case "7"
txtDecena = "Setenta"
If Unidad <> "0" Then
txtDecena = "Setenta y "
End If
Case "8"
txtDecena = "Ochenta"
If Unidad <> "0" Then
txtDecena = "Ochenta y "
End If
Case "9"
txtDecena = "Noventa"
If Unidad <> "0" Then
txtDecena = "Noventa y "
End If
End Select

If Decena <> "1" Then
Select Case Unidad
Case "1"
If IsCientos = False Then
txtUnidad = "Un"
Else
txtUnidad = "Uno"
End If
Case "2"
txtUnidad = "Dos"
Case "3"
txtUnidad = "Tres"
Case "4"
txtUnidad = "Cuatro"
Case "5"
txtUnidad = "Cinco"
Case "6"
txtUnidad = "Seis"
Case "7"
txtUnidad = "Siete"
Case "8"
txtUnidad = "Ocho"
Case "9"
txtUnidad = "Nueve"
End Select
End If
ConvierteCifra = txtCentena & " " & txtDecena & txtUnidad
End Function


Function ConvierteDecimal(Texto)
Dim Decenadecimal
Dim Unidaddecimal
Dim txtDecenadecimal
Dim txtUnidaddecimal
Decenadecimal = Mid(Texto, 1, 1)
Unidaddecimal = Mid(Texto, 2, 1)

Select Case Decenadecimal
Case "1"
txtDecenadecimal = "Diez"
Select Case Unidaddecimal
Case "1"
txtDecenadecimal = "Once"
Case "2"
txtDecenadecimal = "Doce"
Case "3"
txtDecenadecimal = "Trece"
Case "4"
txtDecenadecimal = "Catorce"
Case "5"
txtDecenadecimal = "Quince"
Case "6"
txtDecenadecimal = "Dieciseis"
Case "7"
txtDecenadecimal = "Diecisiete"
Case "8"
txtDecenadecimal = "Dieciocho"
Case "9"
txtDecenadecimal = "Diecinueve"
End Select
Case "2"
txtDecenadecimal = "Veinte"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Veinti"
End If
Case "3"
txtDecenadecimal = "Treinta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Treinta y "
End If
Case "4"
txtDecenadecimal = "Cuarenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Cuarenta y "
End If
Case "5"
txtDecenadecimal = "Cincuenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Cincuenta y "
End If
Case "6"
txtDecenadecimal = "Sesenta"

If Unidaddecimal <> "0" Then
txtDecenadecimal = "Sesenta y "
End If
Case "7"
txtDecenadecimal = "Setenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Setenta y "
End If
Case "8"
txtDecenadecimal = "Ochenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Ochenta y "
End If
Case "9"
txtDecenadecimal = "Noventa"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Noventa y "
End If
End Select

If Decenadecimal <> "1" Then
Select Case Unidaddecimal
Case "1"
txtUnidaddecimal = "Uno"
Case "2"
txtUnidaddecimal = "Dos"
Case "3"
txtUnidaddecimal = "Tres"
Case "4"
txtUnidaddecimal = "Cuatro"
Case "5"
txtUnidaddecimal = "Cinco"
Case "6"
txtUnidaddecimal = "Seis"
Case "7"
txtUnidaddecimal = "Siete"
Case "8"
txtUnidaddecimal = "Ocho"
Case "9"
txtUnidaddecimal = "Nueve"
End Select
End If
If Decenadecimal = 0 And Unidaddecimal = 0 Then
ConvierteDecimal = "00/100"
Else
ConvierteDecimal = txtDecenadecimal & txtUnidaddecimal
End If
End Function

Otra función para convertir números a letras:

Public Function Convertir(Valor As String) As String
Dim Decimales As String
Dim Resultado As String
Dim Negativo As String
Dim Cent As String
    If IsNull(Valor) Then
        Exit Function
    Else
        If Not IsNumeric(Valor) Then
            Exit Function
        End If
    End If
   
    If Valor >= 1E+18 Then
        MsgBox "La cantidad introducida excede el límite." & vbCrLf & "La cantidad máxima permitida es de un trillón.", vbInformation
    End If
   
    If Valor < 0 Then
        Negativo = "menos"
    End If
   
    'Separamos la parte entera de la decimal.
    Decimales = Mid(Format(Valor, "##0.00"), InStr(1, Format(Valor, "##0.00"), ",", vbTextCompare) + 1)
    Valor = Mid(Format(Valor, "##0.00"), 1, InStr(1, Format(Valor, "##0.00"), ",", vbTextCompare) - 1)
    If Valor < 0 Then
        Valor = -Valor
    End If
    If Valor < 1000000 Then
        Resultado = MenorMilio(Valor)
    End If
   
    If Valor >= 1000000 And Valor < 1000000000000# Then
        Resultado = MenorMilio(Int(Valor / 1000000)) & " "
        Resultado = Resultado & IIf(Int(Valor / 1000000) = 1, "millón", "millones")
        Resultado = Resultado & " " & MenorMilio(Valor - (Int(Valor / 1000000) * 1000000))
    End If
    If Valor >= 1000000000000# And Valor < 1E+18 Then
   
        Resultado = MenorMilio(Int(Valor / 1000000000000#)) & " "
        Resultado = Resultado & IIf(Int(Valor / 1000000000000#) = 1, "billón", "billones")
   
        If Valor - (Int(Valor / 1000000000000#) * 1000000000000#) >= 1000000 Then
            Resultado = Resultado & " " & MenorMilio(Int((Valor - (Int(Valor / 1000000000000#) * 1000000000000#)) / 1000000)) & " "
            Resultado = Resultado & IIf(Int((Valor - (Int(Valor / 1000000000000#) * 1000000000000#)) / 1000000) = 1, "milio", "milions")
            Resultado = Resultado & " " & MenorMilio((CDec(Valor) - (Int(Valor / 1000000000000#) * 1000000000000#)) - (Int((Valor - (Int(Valor / 1000000000000#) * 1000000000000#)) / 1000000) * 1000000))
        End If
        
        Resultado = Resultado & " " & MenorMilio(CDec(Valor) - (Int(Valor / 1000000000000#) * 1000000000000#))
    End If
    'Tratamiento de decimales
    If Decimales <> "" Then
        Decimales = MenorCent(Decimales)
    End If
   
    Resultado = Resultado & Switch(Round(Valor, 0) = 0, "", Valor < 2, " Euro", Valor >= 2, " Euros")
   
    'Con esta condición controlo si es un céntimo o más de uno
    Cent = IIf(Decimales <> "un", " céntimos", " céntimo")
  
    If Round(Valor, 0) = 0 Then
        Resultado = IIf(Decimales <> "", Decimales & Cent, "")
    Else
        Resultado = Resultado & IIf(Decimales <> "", " con " & Decimales & Cent, "")
    End If
   
    Resultado = IIf(Negativo <> "", Negativo & " ", "") & Resultado
   
    'Retorno el resultado en letras
    Convertir = Resultado
   
End Function

Public Function Menor21(Valor As String) As String
                 
         If Valor = 0 Then Menor21 = ""
         If Valor = 1 Then Menor21 = "un"
         If Valor = 2 Then Menor21 = "dos"
         If Valor = 3 Then Menor21 = "tres"
         If Valor = 4 Then Menor21 = "cuatro"
         If Valor = 5 Then Menor21 = "cinco"
         If Valor = 6 Then Menor21 = "seis"
         If Valor = 7 Then Menor21 = "siete"
         If Valor = 8 Then Menor21 = "ocho"
         If Valor = 9 Then Menor21 = "nueve"
         If Valor = 10 Then Menor21 = "diez"
         If Valor = 11 Then Menor21 = "once"
         If Valor = 12 Then Menor21 = "doce"
         If Valor = 13 Then Menor21 = "trece"
         If Valor = 14 Then Menor21 = "catorce"
         If Valor = 15 Then Menor21 = "quince"
         If Valor = 16 Then Menor21 = "dieciseis"
         If Valor = 17 Then Menor21 = "diecisiete"
         If Valor = 18 Then Menor21 = "dieciocho"
         If Valor = 19 Then Menor21 = "diecinueve"
         If Valor = 20 Then Menor21 = "veinte"
                 
End Function
Public Function MenorCent(Valor As String) As String
   
    If Val(Valor) <= 20 Then MenorCent = Menor21(Valor)
    If Val(Valor) > 20 And Val(Valor) < 30 Then MenorCent = "veinti" & Menor21(Valor - 20)
    If Val(Valor) = 30 Then MenorCent = "treinta"
    If Val(Valor) > 30 And Val(Valor) < 40 Then MenorCent = "treinta y " & Menor21(Valor - 30)
    If Val(Valor) = 40 Then MenorCent = "cuarenta"
    If Val(Valor) > 40 And Val(Valor) < 50 Then MenorCent = "cuarenta y " & Menor21(Valor - 40)
    If Val(Valor) = 50 Then MenorCent = "cincuenta"
    If Val(Valor) > 50 And Val(Valor) < 60 Then MenorCent = "cincuenta y " & Menor21(Valor - 50)
    If Val(Valor) = 60 Then MenorCent = "sesenta"
    If Val(Valor) > 60 And Val(Valor) < 70 Then MenorCent = "sesenta y " & Menor21(Valor - 60)
    If Val(Valor) = 70 Then MenorCent = "setenta"
    If Val(Valor) > 70 And Val(Valor) < 80 Then MenorCent = "setenta y " & Menor21(Valor - 70)
    If Val(Valor) = 80 Then MenorCent = "ochenta"
    If Val(Valor) > 80 And Val(Valor) < 90 Then MenorCent = "ochenta y " & Menor21(Valor - 80)
    If Val(Valor) = 90 Then MenorCent = "noventa"
    If Val(Valor) > 90 And Val(Valor) < 100 Then MenorCent = "noventa y " & Menor21(Valor - 90)
   
End Function
Public Function MenorMil(Valor As String) As String
    Dim numero As String  'Compruebo si el numero es 9, le cambio el formato a "nove" para las centenas
   
    If Valor < 100 Then MenorMil = MenorCent(Valor)
    If Valor = 100 Then MenorMil = "cien"
    If Valor > 100 And Valor < 200 Then MenorMil = "ciento " & MenorCent(Valor Mod 100)
   
    If Valor >= 200 Then
        numero = Menor21(Valor  100)
        Select Case numero
            Case "cinco"
                numero = "quiniento"
                MenorMil = numero & IIf(Valor > 199, "s", "") & " " & MenorCent(Valor Mod 100)
            Case "siete"
                numero = "sete"
                MenorMil = numero & "ciento" & IIf(Valor > 199, "s", "") & " " & MenorCent(Valor Mod 100)
            Case "nueve"
                numero = "nove"
                MenorMil = numero & "ciento" & IIf(Valor > 199, "s", "") & " " & MenorCent(Valor Mod 100)
            Case Else
                MenorMil = numero & "ciento" & IIf(Valor > 199, "s", "") & " " & MenorCent(Valor Mod 100)
        End Select
    End If
   
End Function
   
Public Function MenorMilio(Valor As String) As String
   
    If Valor < 1000 Then
        MenorMilio = MenorMil(Valor)
    End If
   
    If Valor = 1000 Then
        MenorMilio = "mil"
    End If
    If Valor > 1000 And Valor < 1000000 Then
        MenorMilio = IIf(Valor  1000 = 1, "mil ", MenorMil(Valor  1000) & " mil ") & MenorMil(Valor Mod 1000)
    End If
   
End Function

Y otras funciones que podéis descargar y están en un fichero .mdb:

23 comentarios en «Convertir números a letras en Access»

  1. numeros a letras en acces,

    hola tienes razon , pero realmente no encuentro la tabla donde estan alojados los datos supongo que lo realizaron por código, lo que necesito es que esto quede guardado en una tabla para yo poder modificarla gracias.
    La tabla debe contener dos campos valor numeros y valor en letras un formulario y listo, mil gracias.

    Responder
  2. acces convertir letras en números

    Buen día
    Amigos me podrian colaborar necesito una db para imprimir cheques en pesos colombianos me pueden ayudar es que no tengo mucho conocimiento, lo que realmente necesito un formulario con dos cajones de texto uno donde se introduzca el el valor numerico y otro donde aparezca el valor en letras con decimales, lo demas creo que puedo hacerlo, por favor pueden colaborarme? mi correo es [email protected] les estaré muy agradecido.

    Responder
  3. Access

    En el ejemplo se usa un formulario donde se convierte los números a letras, si eso lo quieres guardar en una tabla tan solo tienes que crearla y traspasar esos datos del formulario a la tabla.
    Otra forma sería que el origen de los controles del formulario los cojas de la tabla.

    Responder
  4. Access, convertir números a letras.

    Eso se puede hacer de muchas formas, una sería (como en el ejemplo) convertir en el mismo formulario y guardarlo en la tabla de cabeceras de facturas, luego en el informe tan solo es añadir ese campo.
    Lógicamente tienes que saber algo de código pero viendo el ejemplo, que te puedes descargar, es fácil ver como va, fíjate en los eventos y funciones.

    Responder
  5. Convertir números a letras en access

    he leído vuestro truco y me parece genial, el problema mío es que prácticamente no se nada de visual y no se cómo aplicar el código, en concreto yo trabajo con un formulario de compras que genera un informe con el detalle de la factura, quisiera que en ese informe me saliera la cantidad en letras, pero no se donde incorporar el código,
    muchas gracias

    Responder
  6. POR FAVOR

    señores muchas gracias por podrian colaborarme en enviarme un link o algo parecido para yo poder descargar el formulario ya hecho, la verdad no tengo conocimientos en acces y entiendo lo del código, solo es un formulario con dos campos de texto , numero y su equivalente en letras,
    Mil gracias por su colaboracion

    Responder
  7. Otra forma un poco mas simple de entender es:

    Option Compare Database
    Public Letras As String
    Public Bandera As Byte
    Function numToLet(cantidad As Double)
    Bandera = 1
    Dim valor1 As String
    Dim valor2 As String
    Dim valor3 As String
    Dim valor4 As String
    Entero = CInt(cantidad)
    Letras = CStr(Entero)
    largo = Len(Trim(Letras))
    Select Case largo
    Case Is = 4
    valor1 = Mid(Letras, 1, 1)
    valor2 = Mid(Letras, 2, 1)
    valor3 = Mid(Letras, 3, 1)
    valor4 = Mid(Letras, 4, 1)
    numToLet = UCase(miles(valor1) & centenas(valor2) & decenas(valor3) & unidad(valor4))
    Case Is = 3
    valor1 = Mid(Letras, 1, 1)
    valor2 = Mid(Letras, 2, 1)
    valor3 = Mid(Letras, 3, 1)
    numToLet = UCase(centenas(valor1) & decenas(valor2) & unidad(valor3))
    Case Is = 2
    v1 = Mid(Letras, 1, 1)
    v2 = Mid(Letras, 2, 1)
    Case Is = 1
    v1 = Mid(Letras, 1, 1)
    Case Else
    MsgBox «Cantidad fuera de rango»
    End Select
    End Function
    Function miles(digito As String)
    PrimeraCifra = digito
    Select Case PrimeraCifra
    Case Is = 1
    NtoL01 = «un mil »
    Case Is = 2
    NtoL01 = «dos mil »
    Case Is = 3
    NtoL01 = «tres mil »
    Case Is = 4
    NtoL01 = «cuatro mil »
    Case Is = 5
    NtoL01 = «cinco mil »
    Case Is = 6
    NtoL01 = «seis mil »
    Case Is = 7
    NtoL01 = «siete mil »
    Case Is = 8
    NtoL01 = «ocho mil »
    Case Is = 9
    NtoL01 = «nueve mil »
    Case Else
    NtoL01 = «»
    End Select
    miles = NtoL01
    End Function
    Function centenas(digito As String)
    PrimeraCifra = digito
    Select Case PrimeraCifra
    Case Is = 1
    NtoL02 = «Ciento »
    Case Is = 2
    NtoL02 = «Doscientos »
    Case Is = 3
    NtoL02 = «Trescientos »
    Case Is = 4
    NtoL02 = «Cuatrocientos »
    Case Is = 5
    NtoL02 = «Quinientos »
    Case Is = 6
    NtoL02 = «Seiscientos »
    Case Is = 7
    NtoL02 = «Setecientos »
    Case Is = 8
    NtoL02 = «Ochocientos »
    Case Is = 9
    NtoL02 = «Novecientos »
    Case Else
    NtoL02 = «»
    End Select
    centenas = NtoL02
    End Function
    Function decenas(digito As String)
    PrimeraCifra = digito
    Select Case PrimeraCifra
    Case Is = 1
    Bandera = 2 ‘ para anular la funcion Unidad cuando el valor es entre 11 y 19
    Select Case Right(Letras, 2)
    Case Is = «10»
    NtoL03 = «Diez»
    Case Is = «11»
    NtoL03 = «Once»
    Case Is = «12»
    NtoL03 = «Doce»
    Case Is = «13»
    NtoL03 = «Trece»
    Case Is = «14»
    NtoL03 = «Catorce»
    Case Is = «15»
    NtoL03 = «Quince»
    Case Is = «16»
    NtoL03 = «Dieciseis»
    Case Is = «17»
    NtoL03 = «Diecisiete»
    Case Is = «18»
    NtoL03 = «Dieciocho»
    Case Is = «19»
    NtoL03 = «Diecinueve»
    End Select
    Case Is = 2
    NtoL03 = «Veinte »
    Case Is = 3
    NtoL03 = «Treinta »
    Case Is = 4
    NtoL03 = «Cuarenta »
    Case Is = 5
    NtoL03 = «Cincuenta »
    Case Is = 6
    NtoL03 = «Sesenta »
    Case Is = 7
    NtoL03 = «Setenta »
    Case Is = 8
    NtoL03 = «Ochenta »
    Case Is = 9
    NtoL03 = «Noventa »
    Case Else
    NtoL03 = «»
    End Select
    decenas = NtoL03
    End Function
    Function unidad(digito As String)
    If Bandera = 2 Then
    Exit Function
    End If
    PrimeraCifra = digito
    Select Case PrimeraCifra
    Case Is = 0
    NtoL04 = «»
    Case Is = 1
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «uno»
    Else
    NtoL04 = » y uno»
    End If
    Case Is = 2
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Dos»
    Else
    NtoL04 = «y Dos»
    End If
    Case Is = 3
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Tres»
    Else
    NtoL04 = «y Tres»
    End If
    Case Is = 4
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Cuatro»
    Else
    NtoL04 = «y Cuatro»
    End If
    Case Is = 5
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Cinco»
    Else
    NtoL04 = «y Cinco»
    End If
    Case Is = 6
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Seis»
    Else
    NtoL04 = «y Seis»
    End If
    Case Is = 7
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Siete»
    Else
    NtoL04 = «y Siete»
    End If
    Case Is = 8
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Ocho»
    Else
    NtoL04 = «y Ocho»
    End If
    Case Is = 9
    If Left(Right(Letras, 2), 1) = «0» Then
    NtoL04 = «Nueve»
    Else
    NtoL04 = «y Nueve»
    End If
    Case Else
    NtoL04 = «»
    End Select
    unidad = NtoL04
    End Function

    Responder
  8. descarga del ejemplo

    hola mi nombre es angelica, no se mucho de access pero estoy buscando la forma de convertir un numero en letras. ya hice la base de datos, la tabla y el formulario.
    en la tabla tengo el campo total con formato letra, solo me falta que en el formulario se vea la letras del total.
    por fa no pude tampoco descargar el ejemplo.
    p.d. el codigo que viene aqui donde lo grabo, y como lo ejecuto, la verdad en macros estoy en ceros….
    muchas gracias por la respuesta….

    Responder
  9. decimales

    saludos, la fórmula que me envían redondea los números décimales y yo necesito que aparezcan completos, ud sabe cuál sería la fórmula para esto: por ejemplo son 5,355.54 cuando lo pasa a letras me dice: trescientos cincuenta y seis 00/100

    Responder
  10. conversión a letras con decimales

    Mira a ver si te vale éste código:
    Option Compare Database
    Option Explicit
    Const MAX_LNG = 9
    Dim dbNum As Database
    Dim rsNum As Recordset
    Dim iPrim As Integer
    Dim iNum3 As Integer
    Dim stCampo As String
    Dim iEnd_un As Integer
    Private Function fConvertir(vNúmero As Variant, stGénero As String) As
    String
    On Error GoTo fConvertir_Err
    Const TBL_NUM = «Números»
    Const TIPO_MASC = «m»
    Const TIPO_FEM = «f»
    Const TIPO_NEUT = «n»
    Dim stTmp As String
    Dim I As Integer, iLong As Integer
    Dim iSing As Integer, iMil As Integer
    Dim iUlt As Integer
    iEnd_un = False
    If stGénero = TIPO_NEUT Then
    iEnd_un = True
    stGénero = TIPO_MASC
    End If
    Set dbNum = CodeDb()
    Set rsNum = dbNum.OpenRecordset(TBL_NUM, DB_OPEN_TABLE)
    rsNum.Index = «PrimaryKey»
    vNúmero = CStr((vNúmero))
    iLong = Len(vNúmero)
    iNum3 = iLong 3 ‘Conseguir Nº veces de 3 cifras
    iPrim = iLong Mod 3 ‘Conseguir Nº de dígitos restantes: 1 ó 2
    ‘Si el número es mayor de 9 cifras devolver cadena longitud 0
    If iLong > MAX_LNG Then Exit Function
    ‘si el número es mayor de 6 cifras tratar en masculino (una millón… no
    existe)
    If iLong > 6 Then
    stCampo = «m»
    Else
    stCampo = stGénero
    End If
    ‘Verificar si los dígitos restantes (los primeros) es «1»
    ‘para saber si es una cantidad «mil» y no evaluar fGetPrim
    ‘y para saber si es plural 1### (mil…) 1###### (un millón…)
    If iPrim > 0 Then
    If Left(vNúmero, iPrim) = «1» And Not vNúmero = «1» Then
    iSing = True
    If iNum3 2 Then iMil = 1
    End If
    iUlt = iNum3
    If iMil 1 Then stTmp = Trim$(fGetPrim(Left(vNúmero, iPrim), iUlt,
    iMil))
    End If
    ‘Verificar si la cantidad es «*001###»
    ‘para saber si es una cantidad «mil» y no evaluar fGetResto
    If iLong > 5 And Left$(Right(vNúmero, 6), 3) = «001» Then
    iMil = 2
    End If
    For I = 1 To iNum3
    ‘si se dijo que era una unidad después del primer tercio es plural
    If I > 1 Then iSing = False
    ‘si se forzó a masculino dejar de serlo después del primer tercio
    If I > 1 And stCampo stGénero Then stCampo = stGénero
    ‘Get miles o millones sólo si existen dígitos restantes o después
    del primer tercio
    If (iPrim > 0 Or I > 1) Then
    If I > 1 And I < iNum3 + 1 Then If Not Mid$(vNúmero, iPrim + 1 + ((I - 2) * 3), 3) = "000" Then stTmp = Trim$(stTmp & " " & fGetMil(iNum3 + 1 - I, iSing)) End If Else stTmp = Trim$(stTmp & " " & fGetMil(iNum3 + 1 - I, iSing)) End If End If If (I = iNum3 - 1 And iMil 2) Or I iNum3 - 1 Then stTmp = Trim$(stTmp & " " & fGetResto(Mid$(vNúmero, ((I - 1) * 3) + 1 + iPrim, 3), I, iMil)) Next I fConvertir = Trim$(stTmp) fConvertir_Salida: On Error Resume Next rsNum.Close dbNum.Close Exit Function fConvertir_Err: Beep MsgBox Error$, 48 Or 0, "Conversión números en letras" Resume fConvertir_Salida End Function Private Function fGetMil(I As Integer, iSing As Integer) As String Dim stTmp As String If I = 2 Then If iSing Then stTmp = "MILLÓN" Else stTmp = "MILLONES" End If ElseIf I = 1 Or I = 3 Then stTmp = "MIL" End If fGetMil = stTmp End Function Private Function fGetPrim(n As String, iP As Integer, iMil) As String Const UNION_NUMEROS = " Y " Const NUM_DOBLE_1 = "21" Const NUM_DOBLE_2 = "1" Dim stTmp As String Dim stn As String stn = CStr(CInt(n)) If iEnd_un Then iP = iEnd_un If (iP And (stn = NUM_DOBLE_1 Or stn = NUM_DOBLE_2)) Then rsNum.Seek "=", stn + "+" Else rsNum.Seek "=", stn End If If Not rsNum.NoMatch Then If Not (n = "000") Then stTmp = rsNum(stCampo) Else rsNum.Seek "=", Left$(stn, 1) + "0" If Not rsNum.NoMatch Then stTmp = rsNum(stCampo) If (iMil 1 And Right(stn, 1) = NUM_DOBLE_2) And Not (iEnd_un = False And iP = False) Then rsNum.Seek "=", Right$(stn, 1) + "+" Else rsNum.Seek "=", Right$(stn, 1) End If If Len(stTmp) Then If Not rsNum.NoMatch Then stTmp = stTmp & UNION_NUMEROS & rsNum(stCampo) Else If Not rsNum.NoMatch Then stTmp = rsNum(stCampo) End If End If fGetPrim = stTmp End Function Private Function fGetResto(n As String, I As Integer, iMil As Integer) As String Const UNO_EN_CENTENAS = "CIENTO " Dim stTmp As String Dim st1num As String Dim iUlt As Integer If I < iNum3 Then iUlt = True st1num = Left(n, 1) rsNum.Seek "=", n If Not rsNum.NoMatch Then stTmp = rsNum(stCampo) Else Select Case st1num Case "0": stTmp = fGetPrim(n, iUlt, iMil) Case "1": stTmp = UNO_EN_CENTENAS & fGetPrim(Right(n, 2), iUlt, iMil) Case Else rsNum.Seek "=", st1num & "00" If Not rsNum.NoMatch Then stTmp = rsNum(stCampo) & " " & fGetPrim(Right(n, 2), iUlt, iMil) End If End Select End If fGetResto = stTmp End Function Function nl_ConvAuto(vNúmero As Variant, stGénero As String) On Error GoTo nl_ConvertirAuto_Err Const TXT_UNION = " CON " Dim stDec As String stDec = nl_ConvDecimal(vNúmero, stGénero) If Len(stDec) Then nl_ConvAuto = nl_ConvEntero(vNúmero, stGénero) & TXT_UNION & stDec Else nl_ConvAuto = nl_ConvEntero(vNúmero, stGénero) End If Exit Function nl_ConvertirAuto_Err: Beep MsgBox Error$, 48 Or 0, "Conversión automática de decimales" Exit Function End Function Function nl_ConvDecimal(vNúmero As Variant, stGénero As String) As String On Error GoTo nl_ConvDecimal_Err Const TXT_0 = "CERO " Const INICIO_DEC = 2 Dim iCeros As Integer, iLong_Num As Integer Dim stTmp As String, I As Integer Dim stGen As String, vTmp As Variant If Not IsNumeric(vNúmero) Then Exit Function vTmp = CDbl(vNúmero) Dim iLong_Ent As Integer, iInicDec As Integer iLong_Ent = Len(CStr(Fix(vTmp))) If Fix(vTmp) = 0 Then iInicDec = INICIO_DEC - 1 Else iInicDec = INICIO_DEC End If If iLong_Ent + iInicDec > Len(CStr(vTmp)) Then Exit Function
    vTmp = (Mid(vTmp, iLong_Ent + iInicDec))
    stGen = stGénero
    iLong_Num = Len(CStr(vTmp))
    If iLong_Num > MAX_LNG Then
    vTmp = Left(vTmp, MAX_LNG)
    iLong_Num = MAX_LNG
    End If
    If iLong_Num > 0 Then
    vTmp = Fix(vTmp)
    iCeros = iLong_Num – Len(CStr(vTmp))
    If iCeros Then
    For I = 1 To iCeros
    stTmp = stTmp & TXT_0
    Next I
    End If
    If vTmp < 10 And iLong_Num = 1 Then vTmp = vTmp * 10 stTmp = stTmp & fConvertir(vTmp, stGen) nl_ConvDecimal = stTmp End If Exit Function nl_ConvDecimal_Err: Beep MsgBox Error$, 48 Or 0, "Conversión de decimales" Exit Function End Function Function nl_ConvEntero(vNúmero As Variant, stGénero As String) As String On Error GoTo nl_ConvEntero_Err Const TXT_SGN = "MENOS " Dim stGen As String, stTmp As String, iSgn As Integer If Not IsNumeric(vNúmero) Then Exit Function stGen = stGénero iSgn = Sgn(vNúmero) If iSgn = -1 Then stTmp = TXT_SGN stTmp = stTmp & fConvertir(Fix(Abs(vNúmero)), stGen) nl_ConvEntero = stTmp Exit Function nl_ConvEntero_Err: Beep MsgBox Error$, 48 Or 0, "Conversión de enteros" Exit Function End Function 'El autor es: Microsol

    Responder
  11. PREGUNTA

    DISCULPA LA MOLESTIA , NO SE SI SIGA EN DISCUSION EL TEMA PERO ME GUSTARIA SABER A CUAL CAMPO DEL FORMULARIO AGREGO EL CODIGO , EN EL QUE ESCRIBO EL NUMERO O EN EL QUE QUIERO QUE APAREZCA CON TEXTO
    Y GRACIAS ES MUY BUENA TU APORTACION

    Responder
  12. HERMANO DISCULPE PERO PODRIA

    HERMANO DISCULPE PERO PODRIA EXPLICARME COMO INGRESO ESE CODIGO EN EN FORMATO O EN LAS PROPIEDADES, YA QUE LO ESCRIVO Y NO GENERA NADA SOLO UN ERROR DE COPILACION Y SI TRATO DE CORREGIR NO ME GENERA RESULTADO ALGUNO GRACIAS

    Responder

Deja un comentario