Function CONVERTIRNUM(Numero As Double, Optional CentimosEnLetra As
Boolean) As String
Dim Moneda As String
Dim Monedas As String
Dim Centimo As String
Dim Centimos As String
Dim Preposicion As String
Dim NumCentimos As Double
Dim Letra As String
Const Maximo = 1999999999.99
'************************************************************
' Parmetros
'************************************************************
Moneda = "Nuevos Soles"
'Nombre de Moneda (Singular)
Monedas = "Nuevos Soles"
'Nombre de Moneda (Plural)
Centimo = "Centavo"
'Nombre de Cntimos (Singular)
Centimos = "Centavos" 'Nombre de Cntimos (Plural)
Preposicion = "Con"
'Preposicin entre Moneda y Cntimos
'************************************************************
'Validar que el Numero est dentro de los lmites
If (Numero >= 0) And (Numero <= Maximo) Then
Letra = NUMERORECURSIVO((Fix(Numero)))
en letras
'Si Numero = 1 agregar leyenda Moneda (Singular)
If (Numero = 1) Then
Letra = Letra & " "
'De lo contrario agregar leyenda Monedas (Plural)
'Convertir el Numero
Else
Letra = Letra & " " & Monedas
End If
NumCentimos = Round((Numero - Fix(Numero)) * 100) 'Obtener los
centimos del Numero
'Si NumCentimos es mayor a cero inicar la conversin
If NumCentimos >= 0 Then
'Si el parmetro CentimosEnLetra es VERDADERO obtener letras para
los cntimos
If CentimosEnLetra Then
Letra = Letra & " " & Preposicion & " " &
NUMERORECURSIVO(Fix(NumCentimos)) 'Convertir los cntimos en letra
'Si NumCentimos = 1 agregar leyenda Centimos (Singular)
If (NumCentimos = 1) Then
Letra = Letra & " Con " & Centimo
'De lo contrario agregar leyenda Centimos (Plural)
Else
Letra = Letra & " Con " & Centimos
End If
'De lo contrario mostrar los cntimos como nmero
Else
If NumCentimos < 10 Then
Letra = Letra & " Con 0" & NumCentimos & "/100 " & Moneda
Else
Letra = Letra & " Con " & NumCentimos & "/100 " & Moneda
End If
End If
End If
'Regresar el resultado final de la conversin
CONVERTIRNUM = Letra
Else
'Si el Numero no est dentro de los lmites, entivar un mensaje de error
CONVERTIRNUM = "ERROR: El nmero excede los lmites."
End If
End Function
Function NUMERORECURSIVO(Numero As Long) As String
Dim Unidades, Decenas, Centenas
Dim Resultado As String
'**************************************************
' Nombre de los nmeros
'**************************************************
Unidades = Array("", "Un", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete",
"Ocho", "Nueve", "Diez", "Once", "Doce", "Trece", "Catorce", "Quince",
"Diecisis", "Diecisiete", "Dieciocho", "Diecinueve", "Veinte", "Veintiuno",
"Veintidos", "Veintitres", "Veinticuatro", "Veinticinco", "Veintiseis",
"Veintisiete", "Veintiocho", "Veintinueve")
Decenas = Array("", "Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta",
"Sesenta", "Setenta", "Ochenta", "Noventa", "Cien")
Centenas = Array("", "Ciento", "Doscientos", "Trescientos", "Cuatrocientos",
"Quinientos", "Seiscientos", "Setecientos", "Ochocientos", "Novecientos")
'**************************************************
Select Case Numero
Case 0
Resultado = "Cero"
Case 1 To 29
Resultado = Unidades(Numero)
Case 30 To 100
Resultado = Decenas(Numero \ 10) + IIf(Numero Mod 10 <> 0, " y " +
NUMERORECURSIVO(Numero Mod 10), "")
Case 101 To 999
Resultado = Centenas(Numero \ 100) + IIf(Numero Mod 100 <> 0, " "
+ NUMERORECURSIVO(Numero Mod 100), "")
Case 1000 To 1999
Resultado = "Mil" + IIf(Numero Mod 1000 <> 0, " " +
NUMERORECURSIVO(Numero Mod 1000), "")
Case 2000 To 999999
Resultado = NUMERORECURSIVO(Numero \ 1000) + " Mil" + IIf(Numero
Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
Case 1000000 To 1999999
Resultado = "Un Milln" + IIf(Numero Mod 1000000 <> 0, " " +
NUMERORECURSIVO(Numero Mod 1000000), "")
Case 2000000 To 1999999999
Resultado = NUMERORECURSIVO(Numero \ 1000000) + " Millones" +
IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod
1000000), "")
End Select
NUMERORECURSIVO = Resultado
End Function
Sub pdf()
For i = 9 To 43
Worksheets("Liq ben").Range("i3").Value = i - 7
Nombre = Worksheets("TAREO").Range("b" & i - 3).Value
[Link] Type:=xlTypePDF, Filename:= _
"F:\CONT EMP_EVERCF\JEMAS INGENIERIA SRL\PLanillas\Junio
2014\Encaada\Planilla Normal_remype\pdf\" & Nombre & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True,
IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Next
End Sub
