Después de tanto tiempo, presento este programita hecho en Excel 2013 pero funciona para varias versiones anteriores, tiene tres macros, el de reconcerlos números escritos, el de generar números aleatoriamente y el de borrar, y varias formulas, sencillas que se que ustedes reconocen o pueden construir.
Pero si tienen alguna duda, el archivo no esta protegido, y si todavia tienen duda o dudas, pueden mandarme un correo, pero sobre el archivo, o lo expuesto en este blog, de otro asunto, lo veo difícil, para que puede consutar las formulas y macros (simpre hay gente que le gusta ir más allá) no esta protegido, ya me conocen, todo lo encamino a lo didáctico.
Aquí les dejo el Archivo para que lo bajen, solo les encargo el crédito, y un gracias.
Si les gusta pasen la información.
macros de números a letras:
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
'************************************************************
' Parámetros
'************************************************************
Moneda = "Peso" 'Nombre de Moneda (Singular)
Monedas = "Pesos" 'Nombre de Moneda (Plural)
Centimo = "Centavo" 'Nombre de Céntimos (Singular)
Centimos = "Centavos" 'Nombre de Céntimos (Plural)
Preposicion = "Con" 'Preposición entre Moneda y Céntimos
'************************************************************
'Validar que el Numero está dentro de los límites
If (numero >= 0) And (numero <= Maximo) Then
Letra = NUMERORECURSIVO((Fix(numero))) 'Convertir el Numero en letras
'Si Numero = 1 agregar leyenda Moneda (Singular)
If (numero = 1) Then
Letra = Letra
'De lo contrario agregar leyenda Monedas (Plural)
Else
Letra = Letra
End If
NumCentimos = Round((numero - Fix(numero)) * 100) 'Obtener los centimos del Numero
'Si NumCentimos es mayor a cero inicar la conversión
If NumCentimos >= 0 Then
'Si el parámetro CentimosEnLetra es VERDADERO obtener letras para los céntimos
If CentimosEnLetra Then
Letra = Letra & " " & Preposicion & " " & NUMERORECURSIVO(Fix(NumCentimos)) 'Convertir los céntimos en letra
'Si NumCentimos = 1 agregar leyenda Centimos (Singular)
If (NumCentimos = 1) Then
Letra = Letra & " " & Centimo
'De lo contrario agregar leyenda Centimos (Plural)
Else
Letra = Letra & " " & Centimos
End If
'De lo contrario mostrar los céntimos como número
Else
If NumCentimos < 10 Then
Letra = Letra
Else
Letra = Letra
End If
End If
End If
'Regresar el resultado final de la conversión
CONVERTIRNUM = Letra
Else
'Si el Numero no está dentro de los límites, entivar un mensaje de error
CONVERTIRNUM = "ERROR: El número excede los límites."
End If
End Function
Function NUMERORECURSIVO(numero As Long) As String
Dim Unidades, Decenas, Centenas
Dim Resultado As String
'**************************************************
' Nombre de los números
'**************************************************
Unidades = Array("", "Uno", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve", "Diez", "Once", "Doce", "Trece", "Catorce", "Quince", "Dieciséis", "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 Millón" + 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
macros de borrar
Sub borrar2()
'
' borrar Macro
'
Range("e6").Select
Selection.ClearContents
Range("e8").Select
Selection.ClearContents
Range("e10").Select
Selection.ClearContents
Range("e12").Select
Selection.ClearContents
Range("e14").Select
Selection.ClearContents
Range("e16").Select
Selection.ClearContents
Range("e18").Select
Selection.ClearContents
Range("e20").Select
Selection.ClearContents
Range("e22").Select
Selection.ClearContents
Range("e24").Select
Selection.ClearContents
End Sub
Tiene oculta la columna "F" y el la celda "G " tiene la formula : =SI(E6="","",SI(E6=F6,"a","r"))y el contador de aciertos: =CONTAR.SI(G6:G24,"a")
También tiene una macos para generar un número aleatorio en este caso de 5 cifras:
Sub numero()
n = Int(Rnd() * 1000)
Range("c6") = n
n = Int(Rnd() * 1000)
Range("c8") = n
End Sub
Tiene oculta la columna "F" y el la celda "G " tiene la formula : =SI(E6="","",SI(E6=F6,"a","r"))y el contador de aciertos: =CONTAR.SI(G6:G24,"a")
Eso es todo, espero que les sirva y les guste, es mucho el esfuerzo y un gracias sería buena recompensa.............gracias a ustedes por la visita.
