Función Numero a Letras

roberto

New Member
Joined
Aug 28, 2002
Messages
43
Buenas tardes a todos:
Tengo un problema en cuanto a una función de convertir numeros a letras (en moneda), y es en el caso de cuando selecciono el tipo de moneda 3 (1=pesos, 2=USD, 3=homologado (pesos/dolares)), me pueden indicar o ayudar por favor, como cuando se selecciona la moneda 3 deseo aplicar el tipo de cambio y que unicamente afecte a la porcion de dolares y no a la de pesos, pero que sin embargo la cantidad introducida en pesos me la traduzca en letras y la de dolares este afectado por el tipo de cambio y que tambien lo traduzca a letras. No se si me explico bien, pero pueden aplicar el codigo de dicha función y hacer un ejemplo. Otro favor: es posible hacer que unicamente el campo de tipo de cambio se active solo con el tipo de moneda 3 y no con los otros dos?.
De antemano muchas gracias...

'***********************************************************************
'Funciones para convertir de números a letras
'Llamada : Letras(Número,Moneda,Estilo;Tipo_Cambio) - Moneda 1-Pesos, 2-Dólares, 3-Homologado
Private 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

Private Function Decenas(num1, res)
Dim d1
d1 = Array("ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", _
"DIECIOCHO", "DIECINUEVE")
d2 = Array("DIEZ", "VEINT", "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 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

Private 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

Private 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

Private 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

Private Function decimales(Numero As Single) As Integer
Dim iaux As Integer
iaux = Numero - Application.Round(Numero, 2)
decimales = iaux
End Function

Public Function NumALetras(Cantidad As Variant, ByVal Moneda As Integer, ByVal Estilo As Integer, ByVal Tipo_Cambio As Integer) As String
Dim cants1 As String, num1 As Variant, num2 As Variant

num1 = Cantidad 1000000
num2 = Cantidad - (num1 * 1000000)

cents = (num2 * 100) Mod 100
If cents = 0 Then
cents1 = "00"
Else
cents1 = Format(cents)
End If
Cantidad = Cantidad - (cents / 100)
If Cantidad >= 1000000 Then
cantlm = Millones(Cantidad 1000000)
Cantidad = Cantidad Mod 1000000
End If
If Cantidad > 0 Then
If (Cantidad >= 1000) Then
cantlm = cantlm & Miles(Cantidad 1000)
Cantidad = Cantidad Mod 1000
End If
End If
If Cantidad > 0 Then
If Cantidad >= 100 Then
cantlm = cantlm & Cientos(Cantidad)
Else
If Cantidad >= 10 Then
cantlm = cantlm & Decenas(Cantidad, Cantidad Mod 10)
Else
cantlm = cantlm & Unidades(Cantidad, 1)
End If
End If
End If
If Moneda = 1 Then
NumALetras = cantlm & " PESOS " & cents1 & ""
Select Case Estilo
Case 1
NumALetras = StrConv(NumALetras, vbUpperCase) & "/100 M.N."
Case 2
NumALetras = StrConv(NumALetras, vbLowerCase) & "/100 M.N."
Case Else
NumALetras = StrConv(NumALetras, vbProperCase) & "/100 M.N."
End Select
ElseIf Moneda = 2 Then
NumALetras = cantlm & " DOLARES " & cents1 & ""
Select Case Estilo
Case 1
NumALetras = StrConv(NumALetras, vbUpperCase) & "/100 U.S.D."
Case 2
NumALetras = StrConv(NumALetras, vbLowerCase) & "/100 U.S.D."
Case Else
NumALetras = StrConv(NumALetras, vbProperCase) & "/100 U.S.D."
End Select
ElseIf Moneda = 3 Then
NumALetras = cantlm & " PESOS " & cents1 & "/100 M.N." & "" & Chr(10) & "" & cantlm & " DOLARES " & cents1 & "" & "/100 U.S.D."
Select Case Estilo
Case 1
NumALetras = StrConv(NumALetras, vbUpperCase)
End Select
End If
End Function
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,223,099
Messages
6,170,114
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top