numero a letra

Hola Jojucal, aqui te pongo un codigo para convertir Nº a Letras.

Pasar números a letras.

El siguiente script transforma numeros en su correspondiente descripcion.
Son varias funciones que trabajan de forma independiente.

Estas son:

=Unidades(1 , 1) Uno
=Unidades(1 , 2) Un
=Decenas(12) Doce
=Cientos(125) Ciento veinticinco
=Miles(98) Noventa y ocho mil
=Millones(955445) Novecientos cincuenta y cinco mil cuatrocientos cuarenta
y cinco millones
=Letras(125254.21) Ciento veinticinco mil docientos cincuenta y cuatro
21/00

Este codigo lo encontre en un foro, solo lo modifique un poco quitando un
par de cosas.
En el codigo original a Letras se le pasaba dos parametros.

Letras(Nro , Moneda)
=Letras(1 , 1) (1=Bolivar, 2=Dolares)
Un Bolivar
=Letras(1 , 2)
Un Dolar

Le quite esto para que solo transforme el valor.
=Letras(1)
Uno

El codigo se debe pegar en un moduloAbajo comienza el codigo...
*******************************************************************
Function Unidades(num, UNO)
Dim U
Dim Cad

U = Array("UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE",
"OCHO", "NUEVE")
Cad = ""
If num = 1 Then
If UNO = 1 Then
Cad = Cad & "UNO"
Else
Cad = Cad & "UN"
End If
Else
Cad = Cad & U(num - 1)
End If
Unidades = Cad
End Function

Function Decenas(num1, res)
Dim D1
D1 = Array("ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS",
"DIECISIETE", _
"DIECIOCHO", "DIECINUEVE")
D2 = Array("DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA",
"SESENTA", _
"SETENTA", "OCHENTA", "NOVENTA")

If num1 > 10 And num1 < 20 Then
cad1 = D1(num1 - 10 - 1)
Else
cad1 = D2((num1 \ 10) - 1)
If (num1 \ 10) <> 2 Then
If res > 0 Then
cad1 = cad1 & " Y "
cad1 = cad1 & Unidades(num1 Mod 10, 0)
End If
Else
If cad1 = "VEINTE" Then
cad1 = "VEINT"
End If
If res = 0 Then
cad1 = cad1 & "E"
Else
cad1 = cad1 & "I"
cad1 = cad1 & Unidades(num1 Mod 10, 0)
End If
End If
End If
Decenas = cad1
End Function

Function Cientos(num2)
num3 = num2 \ 100
Select Case num3
Case 1
If num2 = 100 Then
cad2 = "CIEN "
Else
cad2 = "CIENTO "
End If
Case 5
cad2 = "QUINIENTOS "
Case 7
cad2 = "SETECIENTOS "
Case 9
cad2 = "NOVECIENTOS "
Case Else
cad2 = Unidades(num3, 0) & "CIENTOS "
End Select

num2 = num2 Mod 100
If num2 > 0 Then
If num2 < 10 Then
cad2 = cad2 & Unidades(num2, num2)
Else
cad2 = cad2 & Decenas(num2, num2 Mod 10)
End If
End If
Cientos = cad2
End Function

Function Miles(num4)
If (num4 >= 100) Then
cad3 = Cientos(num4)
Else
If (num4 >= 10) Then
cad3 = Decenas(num4, num4 Mod 10)
Else
cad3 = Unidades(num4, 0)
End If
End If
cad3 = cad3 & " MIL "
Miles = cad3
End Function

Function Millones(cant)
If cant = 1 Then
ter = " "
Else
ter = "ES "
End If
If (cant >= 1000) Then
cantl = cantl & Miles(cant \ 1000)
cant = cant Mod 1000
End If
If cant > 0 Then
If cant >= 100 Then
cantl = cantl & Cientos(cant)
Else
If cant >= 10 Then
cantl = cantl & Decenas(cant, cant Mod 10)
Else
cantl = cantl & Unidades(cant, 0)
End If
End If
End If
Millones = cantl & " MILLON" & ter
End Function
Function decimales(numero As Single) As Integer
Dim iaux As Integer
iaux = numero - Application.Round(numero, 2)
decimales = iaux
End Function

Function letras(cantm As Variant) As String
Dim cants1 As String, num1 As Variant, num2 As Variant

num1 = cantm \ 1000000
num2 = cantm - (num1 * 1000000)

cents = (num2 * 100) Mod 100
If cents = 0 Then
cents1 = ""
Else
cents1 = "con " & letras(cents)
End If
cantm = cantm - (cents / 100)
If cantm >= 1000000 Then
cantlm = Millones(cantm \ 1000000)
cantm = cantm Mod 1000000
End If
If cantm > 0 Then
If (cantm >= 1000) Then
cantlm = cantlm & Miles(cantm \ 1000)
cantm = cantm Mod 1000
End If
End If
If cantm > 0 Then
If cantm >= 100 Then
cantlm = cantlm & Cientos(cantm)
Else
If cantm >= 10 Then
cantlm = cantlm & Decenas(cantm, cantm Mod 10)
Else
cantlm = cantlm & Unidades(cantm, 1)
End If
End If
End If
letras = cantlm & " " & cents1
End Function


Daniel.

"jojucal" escribió en el mensaje
news:

hay alguna funcion que convierta una cantidad puesta en número en una
celda
para que la ponga en letras en otra celda?

Ayer estaba buscando lo mismo que tu y encontre esta respuesta y me parecio
super excelente !! revisala para ver que te parece !!!
espero te sirva porque a mi me ayubo muchisimo !!
bye

Option Explicit
'Mauricio Baeza
'Samuel Monajaras
'Enero-97
'Ultima modificacion Octubre del 2002
'
'http://www.vbalym.netfirms.com
'Argumentos:
'Numero = Valor que deseamos convertir en texto
'Moneda = es el nombre de la moneda a mostrar
'Fraccion_Letras = Verdadero para que la fraccion de la moneda
' tambien la convierta a letras
'Fraccion = Es el nombre de la fraccion de la moneda
'Texto_Inicial = Cualquier texto que quieras al principio del resultado
'Texto_Final = Cualquier texto que quieras al finla del resultado
'Estilo = Formato de salida
' 1 = MAYUSCULAS
' 2 = minusculas
' 3 = Tipo Titulo
'Los valores negativos los convierte a positivos
'El valor minimo en 0, el valor maximo es 9,999,999,999,999.99

Public Function Numeros_Letras(ByVal Numero As Double, _
ByVal Moneda As String, _
Optional Fraccion_Letras As Boolean = False, _
Optional Fraccion As String = "", _
Optional Texto_Inicial As String = "", _
Optional Texto_Final As String = "", _
Optional Estilo As Integer = 1) As String
Dim strLetras As String
Dim NumTmp As String
Dim intFraccion As Integer

strLetras = Texto_Inicial
'Convertimos a positivo si es negativo
Numero = Abs(Numero)
NumTmp = Format(Numero, "000000000000000.00")
If Numero < 1 Then
strLetras = strLetras & "cero " & Plural(Moneda) & " "
Else
strLetras = strLetras & NumLet(Val(Left(NumTmp, 15)))
If Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
strLetras = strLetras & Moneda & " "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
strLetras = strLetras & "de " & Plural(Moneda) & " "
Else
strLetras = strLetras & Plural(Moneda) & " "
End If
End If
If Fraccion_Letras Then
intFraccion = Val(Right(NumTmp, 2))
Select Case intFraccion
Case 0
strLetras = strLetras & "con cero " & Plural(Fraccion)
Case 1
strLetras = strLetras & "con un " & Fraccion
Case Else
strLetras = strLetras & "con " & NumLet(Val(Right(NumTmp, 2))) &
Plural(Fraccion)
End Select
Else
strLetras = strLetras & Right(NumTmp, 2)
End If
strLetras = strLetras & Texto_Final
Select Case Estilo
Case 1
strLetras = StrConv(strLetras, vbUpperCase)
Case 2
strLetras = StrConv(strLetras, vbLowerCase)
Case 3
strLetras = StrConv(strLetras, vbProperCase)
End Select

Numeros_Letras = strLetras

End Function

Public Function NumLet(ByVal Numero As Double) As String
Dim NumTmp As String
Dim co1 As Integer
Dim co2 As Integer
Dim pos As Integer
Dim dig As Integer
Dim cen As Integer
Dim dec As Integer
Dim uni As Integer
Dim letra1 As String
Dim letra2 As String
Dim letra3 As String
Dim Leyenda As String
Dim TFNumero As String

NumTmp = Format(Numero, "000000000000000") 'Le da un formato fijo
co1 = 1
pos = 1
TFNumero = ""
'Para extraer tres digitos cada vez
Do While co1 <= 5
co2 = 1
Do While co2 <= 3
'Extrae un digito cada vez de izquierda a derecha
dig = Val(Mid(NumTmp, pos, 1))
Select Case co2
Case 1: cen = dig
Case 2: dec = dig
Case 3: uni = dig
End Select
co2 = co2 + 1
pos = pos + 1
Loop
letra3 = Centena(uni, dec, cen)
letra2 = Decena(uni, dec)
letra1 = Unidad(uni, dec)

Select Case co1
Case 1
If cen + dec + uni = 1 Then
Leyenda = "billon "
ElseIf cen + dec + uni > 1 Then
Leyenda = "billones "
End If
Case 2
If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then
Leyenda = "mil millones "
ElseIf cen + dec + uni >= 1 Then
Leyenda = "mil "
End If
Case 3
If cen + dec = 0 And uni = 1 Then
Leyenda = "millon "
ElseIf cen > 0 Or dec > 0 Or uni > 1 Then
Leyenda = "millones "
End If
Case 4
If cen + dec + uni >= 1 Then
Leyenda = "mil "
End If
Case 5
If cen + dec + uni >= 1 Then
Leyenda = ""
End If
End Select

co1 = co1 + 1
TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda

Leyenda = ""
letra1 = ""
letra2 = ""
letra3 = ""
Loop

NumLet = TFNumero

End Function

Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
ByVal cen As Integer) As String
Dim cTexto As String

Select Case cen
Case 1
If dec + uni = 0 Then
cTexto = "cien "
Else
cTexto = "ciento "
End If
Case 2: cTexto = "doscientos "
Case 3: cTexto = "trescientos "
Case 4: cTexto = "cuatrocientos "
Case 5: cTexto = "quinientos "
Case 6: cTexto = "seiscientos "
Case 7: cTexto = "setecientos "
Case 8: cTexto = "ochocientos "
Case 9: cTexto = "novecientos "
Case Else: cTexto = ""
End Select
Centena = cTexto

End Function

Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto As String

Select Case dec
Case 1:
Select Case uni
Case 0: cTexto = "diez "
Case 1: cTexto = "once "
Case 2: cTexto = "doce "
Case 3: cTexto = "trece "
Case 4: cTexto = "catorce "
Case 5: cTexto = "quince "
Case 6 To 9: cTexto = "dieci"
End Select
Case 2:
If uni = 0 Then
cTexto = "veinte "
ElseIf uni > 0 Then
cTexto = "veinti"
End If
Case 3: cTexto = "treinta "
Case 4: cTexto = "cuarenta "
Case 5: cTexto = "cincuenta "
Case 6: cTexto = "sesenta "
Case 7: cTexto = "setenta "
Case 8: cTexto = "ochenta "
Case 9: cTexto = "noventa "
Case Else: cTexto = ""
End Select

If uni > 0 And dec > 2 Then cTexto = cTexto + "y "

Decena = cTexto

End Function

Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto As String

If dec <> 1 Then
Select Case uni
Case 1: cTexto = "un "
Case 2: cTexto = "dos "
Case 3: cTexto = "tres "
Case 4: cTexto = "cuatro "
Case 5: cTexto = "cinco "
End Select
End If
Select Case uni
Case 6: cTexto = "seis "
Case 7: cTexto = "siete "
Case 8: cTexto = "ocho "
Case 9: cTexto = "nueve "
End Select

Unidad = cTexto

End Function

'Funcion que convierte al plural el argumento pasado
Private Function Plural(ByVal Palabra As String) As String
Dim pos As Integer
Dim strPal As String

If Len(Trim(Palabra)) > 0 Then
pos = InStr(1, "aeiou", Right(Palabra, 1), vbTextCompare)
If pos > 0 Then
strPal = Palabra & "s"
Else
strPal = Palabra & "es"
End If
End If
Plural = strPal

End Function