Bienvenido(a) a KoalaSoft ::BLog::
lunes, septiembre 08 2008 @ 05:55 CDT

Convertir Números a Letras con Hojas de Cálculo para OpenOffice.org 2.0

Autor: William López Jiménez
Correo electrónico: william [punto] koalasoft [arroba] gmail [punto] com
Sitio de Red: http://www.koalasoftmx.net
Jabber ID: koalasoft@jabber.org


Creative Commons Reconocimiento-NoComercial-CompartirIgual 2.5

© 2006-2008 William López Jiménez. Usted es libre de copiar, distribuir y comunicar públicamente la obra y hacer obras derivadas bajo las condiciones siguientes: a) Debe reconocer y citar al autor original. b) No puede utilizar esta obra para fines comerciales (incluyendo su publicación, a través de cualquier medio, por entidades con fines de lucro). c) Si altera o transforma esta obra, o genera una obra derivada, sólo puede distribuir la obra generada bajo una licencia idéntica a ésta. Al reutilizar o distribuir la obra, tiene que dejar bien claro los términos de la licencia de esta obra. Alguna de estas condiciones puede no aplicarse si se obtiene el permiso del titular de los derechos de autor. Los derechos derivados de usos legítimos u otras limitaciones no se ven afectados por lo anterior. Licencia completa en castellano. La información contenida en este documento y los derivados de éste se proporcionan tal cual son y los autores no asumirán responsabilidad alguna si el usuario o lector hace mal uso de éstos.


Para poder convertir Números a letras deberá realizar los siguientes pasos:

 

CONFIGURACIÓN


 

  • Abra la hoja de Cálculo de OpenOffice.org
  • Vaya al menú Herramientas y luego a Macro (ver imagen)
  • Elija “Organizar Macros..
  • Después elija OpenOffice.org Basic,
  • Elegir “NUEVO
  • Elimine las lineas de código que aparecen.
  • Pegue el código correspondiente.
  • Guardar el código.
  • Ahora ya se puede usar la macro en la hoja de calculo (y probablemente en otras partes de OpenOffice)
  • Elija el menú "Archivo" y luego "Cerrar"

 

 

 

 

PRUEBA


  • Abra una hoja de cálculo nueva.
  • Teclee un valor en alguna celda, ej. 123 en la celda A1 y presione ENTER
  • Luego en la celda (A2) teclee: =NUMLET(A1) y presione ENTER

Aparecerá: CIENTO VEINTITRÉS.

 

 

 

Y listo .. puedes codificarlo a tu gusto.!!

 

CÓDIGO DEL MACRO


REM ** CUERPO PRINCIPAL DEL MACRO:
REM ** NO CAMBIA NADA DEL código PARA QUE FUNCIONE
REM ** UNA VEZ PEGADO EL código DA GUARDAR
REM ** CIERRE EL MACRO

Public Function NumLet(ByVal Numero As Double) As String
Dim NumTmp As String
Dim co1 As Integer
Dim co2 As Integer
Dim pos As Integer
Dim dig As Integer
Dim cen As Integer
Dim dec As Integer
Dim uni As Integer
Dim letra1 As String
Dim letra2 As String
Dim letra3 As String
Dim Leyenda As String
Dim TFNumero As String

NumTmp = Format(Numero, "000000000000000") 'Le da un formato fijo
co1 = 1
pos = 1
TFNumero = ""
'Para extraer tres digitos cada vez
Do While co1 <= 5
co2 = 1
Do While co2 <= 3
'Extrae un digito cada vez de izquierda a derecha
dig = Val(Mid(NumTmp, pos, 1))
Select Case co2
Case 1: cen = dig
Case 2: dec = dig
Case 3: uni = dig
End Select
co2 = co2 + 1
pos = pos + 1
Loop
letra3 = Centena(uni, dec, cen)
letra2 = Decena(uni, dec)
letra1 = Unidad(uni, dec)

Select Case co1
Case 1
If cen + dec + uni = 1 Then
Leyenda = "billon "
ElseIf cen + dec + uni > 1 Then
Leyenda = "billones "
End If
Case 2
If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then
Leyenda = "mil millones "
ElseIf cen + dec + uni >= 1 Then
Leyenda = "mil "
End If
Case 3
If cen + dec = 0 And uni = 1 Then
Leyenda = "millon "
ElseIf cen > 0 Or dec > 0 Or uni > 1 Then
Leyenda = "millones "
End If
Case 4
If cen + dec + uni >= 1 Then
Leyenda = "mil "
End If
Case 5
If cen + dec + uni >= 1 Then
Leyenda = ""
End If
End Select

co1 = co1 + 1
TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda
Leyenda = ""
letra1 = ""
letra2 = ""
letra3 = ""
Loop

NumLet = TFNumero

End Function

 

Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
ByVal cen As Integer) As String
Dim cTexto As String

Select Case cen
Case 1
If dec + uni = 0 Then
cTexto = "cien "
Else
cTexto = "ciento "
End If
Case 2: cTexto = "doscientos "
Case 3: cTexto = "trescientos "
Case 4: cTexto = "cuatrocientos "
Case 5: cTexto = "quinientos "
Case 6: cTexto = "seiscientos "
Case 7: cTexto = "setecientos "
Case 8: cTexto = "ochocientos "
Case 9: cTexto = "novecientos "
Case Else: cTexto = ""
End Select
Centena = cTexto

End Function

 

Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto As String

Select Case dec
Case 1:
Select Case uni
Case 0: cTexto = "diez "
Case 1: cTexto = "once "
Case 2: cTexto = "doce "
Case 3: cTexto = "trece "
Case 4: cTexto = "catorce "
Case 5: cTexto = "quince "
Case 6 To 9: cTexto = "dieci"
End Select
Case 2:
If uni = 0 Then
cTexto = "veinte "
ElseIf uni > 0 Then
cTexto = "veinti"
End If
Case 3: cTexto = "treinta "
Case 4: cTexto = "cuarenta "
Case 5: cTexto = "cincuenta "
Case 6: cTexto = "sesenta "
Case 7: cTexto = "setenta "
Case 8: cTexto = "ochenta "
Case 9: cTexto = "noventa "
Case Else: cTexto = ""
End Select

If uni > 0 And dec > 2 Then cTexto = cTexto + "y "

Decena = cTexto

End Function

 

Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto As String

If dec <> 1 Then
Select Case uni
Case 1: cTexto = "un "
Case 2: cTexto = "dos "
Case 3: cTexto = "tres "
Case 4: cTexto = "cuatro "
Case 5: cTexto = "cinco "
End Select
End If
Select Case uni
Case 6: cTexto = "seis "
Case 7: cTexto = "siete "
Case 8: cTexto = "ocho "
Case 9: cTexto = "nueve "
End Select

Unidad = cTexto

End Function

 

'Funcion que convierte al plural el argumento pasado
Private Function Plural(ByVal Palabra As String) As String
Dim pos As Integer
Dim strPal As String

If Len(Trim(Palabra)) > 0 Then
pos = InStr(1, "aeiou", Right(Palabra, 1), vbTextCompare)
If pos > 0 Then
strPal = Palabra & "s"
Else
strPal = Palabra & "es"
End If
End If
Plural = strPal

End Function

 

Este código ha sido probado en OpenOffice.org 2.0 funciona perfectamente y posiblemente también en MS Office.

Codigo fuente de Ing. Mauricio Flores Olmos - 2000-2004
** email: mfolmos@prodigy.net.mx

Para cualquier aclaración respecto al código mostrado, favor de reportarlo al correo antes mencionado.

Última Edición Tuesday, January 15 2008 @ 01:14 PM CST|4,589 Hits Ver la versión para imprimir

 Derechos de autor © 2008 KoalaSoft ::BLog::
 Todas las marcas y derechos en esta página son de sus respectivos dueños.
Otra web montada con  
Diseño y Mantenimiento  

 Condiciones de Uso | Encuestas | Lo mas visto | Contacto

Licencia CC
© 2008 KoalaSoft ::BLog::, © 2008 KoalaSoftmx.
Contenido disponible bajo licencia Creative Commons Reconocimiento 2.5