Espero q el código t sirva!
Option Explicit
'-------------------------------------------------
' Módulo: tNumToLet by JuanC Oct-2005
' Autor: Juan Manuel Romero
' .Basado en el trabajo realizado por:
' Faber Andrés Vergara Holguín
' Cali-Colombia'
' Contacto:
[email protected] '
' Baradero, Buenos Aires - Argentina -
'-------------------------------------------------
'-------------------------------------------------------------
'Función: NumeroALetra
'Argumento: Número real entre 0,00 y 999.999.999,99
'Descripción: Convierte un valor numérico
' a letras con formato moneda (dólar)
' y expresa los decimales de la forma 00/100
'
'
'Mejoras:
' _Soporte para varias monedas
' _Ampliación del campo numérico
' _Verificación de datos ingresados
' _Optimización del código
' _ y cualquier otra cosa que lo haga mejor! ;-)
'
'-------------------------------------------------------------
Public Const cERROR = ""
Function NumeroALetra(Valor_A_Convertir) As String
Dim E57, E58, E59, E60, E61, E62, E63, E64, E65, E66, E67
Dim G57, G58, G59, G60, G61, G62, G63, G64, G65
Dim H57, H58, H59, H60, H61, H62, H63, H64, H65
Dim I57, I58, I59, I60, I61, I62, I63, I64, I65, I66
Dim J57, J58, J59, J60, J61, J62, J63, J64, J65, J66
Dim K57, K58, K59, K60, K61, K62, K63, K64, K65, K66
Dim F68
On Error Resume Next
F68 = Valor_A_Convertir
G57 = 100: G58 = 10: G59 = 1
G60 = 100: G61 = 10: G62 = 1
G63 = 100: G64 = 10: G65 = 1
E57 = Int(F68 / 1000000)
H57 = Int(E57 / G57) * G57
E58 = E57 - H57
H58 = Int(E58 / G58) * G58
If H58 = 0 Then
I58 = ""
Else: I58 = Buscar(E58)
End If
If I58 <> "" Then
E59 = 0
Else: E59 = E58 - H58
End If
H59 = Int(E59 / G59) * G59
E60 = Int((F68 - (Int(F68 / 1000000) * 1000000)) / 1000)
H60 = Int(E60 / G60) * G60
If H57 = 0 Then
I57 = ""
Else: I57 = Buscar(E57)
End If
If H58 > 0 And H59 > 0 Then
I59 = " y "
Else: I59 = ""
End If
E61 = E60 - H60
H61 = Int(E61 / G61) * G61
If H61 = 0 Then
I61 = ""
Else: I61 = Buscar(E61)
End If
If I61 <> "" Then
E62 = 0
Else: E62 = E61 - H61
End If
H62 = Int(E62 / G62) * G62
If H60 = 0 Then
I60 = ""
Else: I60 = Buscar(E60)
End If
If H61 > 0 And H62 > 0 Then
I62 = " y "
Else: I62 = ""
End If
E63 = Int(F68 - Int(F68 / 1000) * 1000)
H63 = Int(E63 / G63) * G63
E64 = E63 - H63
H64 = Int(E64 / G64) * G64
If H63 = 0 Then
I63 = ""
Else: I63 = Buscar(E63)
End If
If H64 = 0 Then
I64 = ""
Else: I64 = Buscar(E64)
End If
If I64 <> "" Then
E65 = 0
Else: E65 = E64 - H64
End If
H65 = Int(E65 / G65) * G65
E66 = (F68 - Int(F68)) * 100
If H64 > 0 And H65 > 0 Then
I65 = " y "
Else: I65 = ""
End If
If (E57 + E58 + E59) > 0 And (E60 + E61 + E62 + E63 + E64 + E65) = 0 Then
I66 = " de "
Else: I66 = ""
End If
I66 = I66 & IIf(F68 = 1, " dólar ", " dólares ")
I66 = I66 & IIf(E66 = 0, " 00", Format(E66, "00"))
If H57 = 0 Or I57 <> "" Then
J57 = ""
Else
If H57 = 100 Then
J57 = " ciento "
Else: J57 = Buscar(H57)
End If
End If
If H58 = 0 Or I58 <> "" Then
J58 = ""
Else: J58 = Buscar(H58)
End If
If H59 = 0 Then
J59 = ""
Else: J59 = Buscar(H59)
End If
J59 = J59 & IIf((H59 + H58 + H57) > 0, IIf((H59 + H58 + H57) > 1, " millones ", " millón "), "")
If H60 = 0 Or I60 <> "" Then
J60 = ""
Else:
If H60 = 100 Then
J60 = " ciento "
Else: J60 = Buscar(H60)
End If
End If
If H61 = 0 Or I61 <> "" Then
J61 = ""
Else: J61 = Buscar(H61)
End If
If H62 = 0 Then
J62 = ""
Else: J62 = Buscar(H62)
End If
J62 = J62 & IIf((H60 + H61 + H62) > 0, " mil ", "")
If H63 = 0 Or I63 <> "" Then
J63 = ""
Else:
If H63 = 100 Then
J63 = " ciento "
Else: J63 = Buscar(H63)
End If
End If
If H64 = 0 Or I64 <> "" Then
J64 = ""
Else: J64 = Buscar(H64)
End If
If H65 = 0 Then
J65 = ""
Else: J65 = Buscar(H65)
End If
J66 = " /100 "
K57 = I57 & J57
K58 = I58 & J58
K59 = I59 & J59
K60 = I60 & J60
K61 = I61 & J61
K62 = I62 & J62
K63 = I63 & J63
K64 = I64 & J64
K65 = I65 & J65
K66 = I66 & J66
NumeroALetra = K57 & " " & K58 & " " & K59 & " " & K60 & " " & K61 & " " & K62 & " " & K63 & " " & K64 & " " & K65 & " " & K66
Do While (InStr(NumeroALetra, " ") > 0)
NumeroALetra = Replace(NumeroALetra, " ", " ")
Loop
NumeroALetra = UCase(Trim(NumeroALetra))
End Function
Private Function Buscar(n) As String
Select Case n
Case 0: Buscar = ""
Case 1: Buscar = "un"
Case 2: Buscar = "dos"
Case 3: Buscar = "tres"
Case 4: Buscar = "cuatro"
Case 5: Buscar = "cinco"
Case 6: Buscar = "seis"
Case 7: Buscar = "siete"
Case 8: Buscar = "ocho"
Case 9: Buscar = "nueve"
Case 10: Buscar = "diez"
Case 11: Buscar = "once"
Case 12: Buscar = "doce"
Case 13: Buscar = "trece"
Case 14: Buscar = "catorce"
Case 15: Buscar = "quince"
Case 16: Buscar = "dieciéis"
Case 17: Buscar = "diecisiete"
Case 18: Buscar = "dieciocho"
Case 19: Buscar = "diecinueve"
Case 20: Buscar = "veinte"
Case 21: Buscar = "veintiun"
Case 22: Buscar = "ventidos"
Case 23: Buscar = "ventitres"
Case 24: Buscar = "venticuatro"
Case 25: Buscar = "venticinco"
Case 26: Buscar = "ventiseis"
Case 27: Buscar = "ventisiete"
Case 28: Buscar = "ventiocho"
Case 29: Buscar = "veintinueve"
Case 30: Buscar = "treinta"
Case 40: Buscar = "cuarenta"
Case 50: Buscar = "cincuenta"
Case 60: Buscar = "sesenta"
Case 70: Buscar = "setenta"
Case 80: Buscar = "ochenta"
Case 90: Buscar = "noventa"
Case 100: Buscar = "cien"
Case 200: Buscar = "doscientos"
Case 300: Buscar = "trescientos"
Case 400: Buscar = "cuatrocientos"
Case 500: Buscar = "quinientos"
Case 600: Buscar = "seiscientos"
Case 700: Buscar = "setecientos"
Case 800: Buscar = "ochocientos"
Case 900: Buscar = "novecientos"
Case Else: Buscar = cERROR
End Select
End Function
'EOF
Saludos desde Buenos Aires, JuanC