Posted By

j_junyent on 12/02/07

Tagged

Versions (?)

Last Edited at 12/02/07 01:00pm

Statistics

Viewed 513 times

Favorited by 0 user(s)

Related snippets

OOo macro: nÃºmeros en letras

/ Published in: Other

OpenOffice.org Calc macro para escribir nÃºmeros en letras

Highlighted TextExpand

REM ** FunciÃ³n que convierte una cantidad pasada como parÃ¡metro en su NOMINACION textual
REM ** Autor: Ing. Mauricio Flores Olmos - 2000-2004
REM ** email: mfolmos@prodigy.net.mx
REM ** Se permite la distribuciÃ³n siempre que se mantenga la referencia anterior al Autor.
REM *************************
REM ** Forma de Uso:
REM ** Abra la hoja de CÃ¡lculo de OpenOffice.org
REM ** Vaya al menu Herramientas y luego a Macro
REM ** Presione el botÃ³n Nuevo
REM ** Le aparecerÃ¡ el editor de StarBasic, elimine las lineas de cÃ³digo que aparecen
REM ** Luego elija el botÃ³n "Insertar texto fuente" de la barra de herramientas (icono de carpeta gris con flecha)
REM ** Presione el botÃ³n "Compilar" de la misma barra, si no marca ningun error, significa que
REM ** la macro la insertÃ³ correctamente.
REM ** Ahora ya se puede usar la macro en la hoja de calculo (y probablemente en otras partes de OpenOffice)
REM ** Elija el menÃº "Archivo" y luego "Cerrar"
REM ** Ahora probemos la macro de dos formas:
REM ** 1.- Teclee un valor en alguna celda, ej. 1253.21 en la celda A1 y presione ENTER
REM ** luego en la celda en que estemos (A2) teclee: =aletra(A1)  y presione ENTER
REM ** aparecerÃ¡: UN MIL DOSCIENTOS CINCUENTA PESOS 21/100 M.N.
REM ** 2.- Teclee lo sigueinte en una celda (Ej. C1): =aletra(563.88)  y presione ENTER
REM ** aparecerÃ¡: QUINIENTOS SESENTA Y TRES PESOS 88/100 M. N.
REM ** eso es todo...

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

URL: http://www.koalasoftmx.net/staticpages/index.php/convertir-numero-a-letras-openoffice/print

Report this snippet Tweet

Comments

Subscribe to comments

Comment:

You need to login to post a comment.

Posted By

Tagged

Versions (?)

Statistics

Related snippets

OOo macro: nÃºmeros en letras

Comments

Choose a language for easy browsing: