/ Published in: Other
OpenOffice.org Calc macro para escribir números en letras
Expand |
Embed | Plain Text
Copy this code and paste it in your HTML
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: [email protected] 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