Codigo "Macro" para convertir # en Letras

Hola sAYk

Busca en el foro la frase: aqui esta la rutina

ahi puse una rutina que encontre, te lo pone en pesos o en dolares

saludos
Ivan

Que tal amigo.. aqui te envio el codigo para conversion de
numero a texto en español.
Hasta pronto.


Option Explicit

Dim cTexto As String 'Variable para las funciones

Public Function Numletras(ByVal Numero As Double, ByVal
Mayusculas As Integer) As String

Dim NumTmp As String
Dim c01 As Integer
Dim c02 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 Leyenda1 As String
Dim TFNumero As String

If Numero < 0 Then Numero = Abs(Numero)

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

Select Case c01
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

c01 = c01 + 1

TFNumero = TFNumero + letra3 + letra2 + letra1 +
Leyenda

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

Loop

If Val(NumTmp) = 0 Or Val(NumTmp) < 1 Then
Leyenda1 = "Cero Pesos "
ElseIf Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
Leyenda1 = "Peso "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp,
10, 6)) = 0 Then
Leyenda1 = "de Pesos "
Else
Leyenda1 = "Pesos "
End If

TFNumero = "(" & TFNumero & Leyenda1 & Mid(NumTmp, 17)
& "/100 M.N.)"

If Mayusculas = 1 Then
TFNumero = UCase(TFNumero)
Else
TFNumero = LCase(TFNumero)
End If

Numletras = TFNumero

End Function


Private Function Centena(ByVal uni As Integer, ByVal dec
As Integer, ByVal cen As Integer) 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
cTexto = ""

End Function


Private Function Decena(ByVal uni As Integer, ByVal dec As
Integer) 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
cTexto = ""

End Function


Private Function Unidad(ByVal uni As Integer, ByVal dec As
Integer) 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
cTexto = ""

End Function

Donde puedo encontrar un codigo que se pueda insertar en

excel via un Modulo

para convierta un valor numérico en palabras. Por

ejemplo, Tener el valor

32.50 Dolares y atraves del codigo que de de

resultado "Treinta y dos

dolares con cincuenta centavos"
Nota: Tengo ya un codigo pero este convierte los valor

numerico unicamente a

valores en letras en ingles. :( Busco la version en

español.

De antemano agradezco su ayuda!
sAYk


.

Gracias Jesus,

"Jesús Peralta" wrote in message
news:953601c48646$10012640$
Que tal amigo.. aqui te envio el codigo para conversion de
numero a texto en español.
Hasta pronto.


Option Explicit

Dim cTexto As String 'Variable para las funciones

Public Function Numletras(ByVal Numero As Double, ByVal
Mayusculas As Integer) As String

Dim NumTmp As String
Dim c01 As Integer
Dim c02 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 Leyenda1 As String
Dim TFNumero As String

If Numero < 0 Then Numero = Abs(Numero)

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

Select Case c01
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

c01 = c01 + 1

TFNumero = TFNumero + letra3 + letra2 + letra1 +
Leyenda

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

Loop

If Val(NumTmp) = 0 Or Val(NumTmp) < 1 Then
Leyenda1 = "Cero Pesos "
ElseIf Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
Leyenda1 = "Peso "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp,
10, 6)) = 0 Then
Leyenda1 = "de Pesos "
Else
Leyenda1 = "Pesos "
End If

TFNumero = "(" & TFNumero & Leyenda1 & Mid(NumTmp, 17)
& "/100 M.N.)"

If Mayusculas = 1 Then
TFNumero = UCase(TFNumero)
Else
TFNumero = LCase(TFNumero)
End If

Numletras = TFNumero

End Function


Private Function Centena(ByVal uni As Integer, ByVal dec
As Integer, ByVal cen As Integer) 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
cTexto = ""

End Function


Private Function Decena(ByVal uni As Integer, ByVal dec As
Integer) 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
cTexto = ""

End Function


Private Function Unidad(ByVal uni As Integer, ByVal dec As
Integer) 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
cTexto = ""

End Function

Donde puedo encontrar un codigo que se pueda insertar en

excel via un Modulo

para convierta un valor numérico en palabras. Por

ejemplo, Tener el valor

32.50 Dolares y atraves del codigo que de de

resultado "Treinta y dos

dolares con cincuenta centavos"
Nota: Tengo ya un codigo pero este convierte los valor

numerico unicamente a

valores en letras en ingles. :( Busco la version en

español.

De antemano agradezco su ayuda!
sAYk


.