Convertir números a letras en Access

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

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:

Categorías: 

Comentarios

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 yesidmail@gmail.com les estaré muy agradecido.

Al final del articulo tienes un enlace donde te puedes descargar un ejemplo.

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.

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.

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....

Ya está solucionado el tema de la descarga, bájate el ejemplo y lo verás mucho más claro.

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

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

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.

Gracias de nuevo por la rapidez, creo que probaré directamente con el formulario integrándolo en mi base

Se puede que al generar esto automaticamente agregue las letras al campo requerido?, Gracias

Una vez generado, lo puedes guardar en cualquier campo.

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

Si miras al final del artículo, hay un enlace para descargar con un claro ejemplo, verás que es precisamente lo que buscas.

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

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

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

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

Descarga el ejemplo y ahí lo puedes ver más claro, si no te aclaras nos lo dices.