macro para poner en literal un número

[christian rodmy]

Hola soy nuevo publicando, talvez a alguien le intereza una macro para poner la numeracion literal a traves de una formula con base numerica =pesos (A?)
lo que tienes que hacer es pegar el siguiente código en un Módulo nuevo ya sea en el libro de macros Personal, o en el libro en el cual estés trabajando.

Esta macro la baje de una pagina que no la recuerdoy la adecue para moneda Bolivianos, lo que puedes hacerlo con la moneda de tu pais cambiandole pesos por tu moneda. Espero les guste, adjunto una planilla excel ya con la macro.
Atte.

Ing. Rodmy
'------------ INICIO DE LA FUNCION PESOS-----------------------------------

Function Pesos(Number As Single) As String

Const MinNum = 1#
Const MaxNum = 4294967295.99

Dim Numbers, Tenths, Result As String
Numbers = Array("CERO", "UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE", "DIEZ", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE")
Tenths = Array("CERO", "DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA")

If (Number >= MinNum) And (Number <= MaxNum) Then
Result = RecurseNumber((Fix(Number)))

If Round((Number - Fix(Number)) * 100) < 10 Then
Result = Result + " 0" + Mid(Str(Round((Number - Fix(Number)) * 100)), 2, 1) + "/100 DOLARES"
Else
Result = Result + " " + Str(Round((Number - Fix(Number)) * 100)) + "/100 DOLARES"
End If
Else
Result = "Error, verifique la cantidad."

End If
Pesos = Result
End Function

Function RecurseNumber(N As Long) As String

Dim Numbers, Tenths
Numbers = Array("CERO", "UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE", "DIEZ", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE")
Tenths = Array("CERO", "DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA")
Hundrens = Array("CERO", "CIENTO", "DOSCIENTOS", "TRESCIENTOS", "CUATROCIENTOS", "QUINIENTOS", "SEISCIENTOS", "SETECIENTOS", "OCHOCIENTOS", "NOVECIENTOS")

Dim Result As String
Select Case N
Case 0
Result = ""
Case 1 To 19
Result = Numbers(N)
Case 20 To 99
If N Mod 10 <> 0 Then
Result = Tenths(N \ 10) + " Y " + RecurseNumber(N Mod 10)
Else
Result = Tenths(N \ 10) + " " + RecurseNumber(N Mod 10)
End If
Case 100 To 999
If N \ 100 = 1 Then
If N = 100 Then
Result = "CIEN" + " " + RecurseNumber(N Mod 100)
Else
Result = Hundrens(N \ 100) + " " + RecurseNumber(N Mod 100)
End If
Else
Result = Hundrens(N \ 100) + " " + RecurseNumber(N Mod 100)
End If
Case 1000 To 999999
Result = RecurseNumber(N \ 1000) + " MIL " + RecurseNumber(N Mod 1000)

Case 1000000 To 1999999
Result = RecurseNumber(N \ 1000000) + " MILLON " + RecurseNumber(N Mod 1000000)
Case 2000000 To 999999999
Result = RecurseNumber(N \ 1000000) + " MILLONES " + RecurseNumber(N Mod 1000000)
Case 1000000000 To 4294967295#
Result = RecurseNumber(N \ 1000000000) + " BILLONES " + RecurseNumber(N Mod 1000000000)

End Select
RecurseNumber = Result
End Function

'———— FIN DE LA FUNCION PESOS———————————–
'Para usarlo es = que una funcion de excel, ejemplo:

'=pesos(suma(a1:a15))
'=pesos(total)