Código fuente de Ing. Mauricio Flores Olmos – 2000-2004
email: mfolmos@prodigy.net.mx
Cualquier duda relacionada con el código a continuación por favor contactar al Autor del mismo.
Pasos a Seguir para Instalar el Macro:
Pasos a Seguir para Instalar el Macro:
Abrir LibreOffice Calc
Hacer Clic en el Menú Herramientas -> Macros -> Organizar Macros -> LibreOffice Basic...
Aparecerá la siguiente ventana en la cual debemos hacer clic en "Organizador"
Al Hacer clic nos aparecerá la siguiente ventana
Hacemos Clic en "Nuevo"
Borramos y ponemos el nombre del nuevo modulo. Una vez hecho esto volvemos a la ventana del Organizador y debemos hacer clic en "Editar" lo cual nos abrirá la siguiente ventana
Borramos el Contenido por defecto y copiamos el código que les coloco a continuación:
Option Explicit
'*************************************************************************************************
' FUNCION PARA CONVERTIR NUMEROS A LETRAS
'
' Copyright (C) 2005 Mauricio Baeza Servin
' Este programa es software libre. Puede redistribuirlo y/o modificarlo bajo los términos de la
' Licencia Pública General de GNU según es publicada por la Free Software Foundation, bien de la
' versión 2 de dicha Licencia o bien (según su elección) de cualquier versión posterior.
'
' Este programa se distribuye con la esperanza de que sea útil, pero SIN NINGUNA GARANTÍA, incluso
' sin la garantía MERCANTIL implícita o sin garantizar la CONVENIENCIA PARA UN PROPÓSITO PARTICULAR.
' Véase la Licencia Pública General de GNU para más detalles.
'
' Debería haber recibido una copia de la Licencia Pública General junto con este programa. Si no ha
' sido así, escriba a la Free Software Foundation, Inc., en 675 Mass Ave, Cambridge, MA 02139, EEUU.
'
' Mauricio Baeza - mauricio@correolibre.net
'
'*************************************************************************************************
'Hago uso de variables bastante explicitas para facilitar la lectura del codigo
'Los comentarios cumplen y complementan la misma funcion
'Ultima modificacion Octubre del 2002
'Argumentos:
'Numero = Valor que deseamos convertir en texto
'Moneda = es el nombre de la moneda a mostrar
'Fraccion_Letras = Verdadero para que la fraccion de la moneda
' tambien la convierta a letras
'Fraccion = Es el nombre de la fraccion de la moneda
'Texto_Inicial = Cualquier texto que quieras al principio del resultado
'Texto_Final = Cualquier texto que quieras al finla del resultado
'Estilo = Formato de salida
' 1 = MAYUSCULAS
' 2 = minusculas
' 3 = Tipo Titulo
'Los valores negativos los convierte a positivos
'El valor minimo en 0, el valor maximo es 9,999,999,999,999.99
Function Numeros_Letras(ByVal Numero As Double, _
ByVal Moneda As String, _
ByVal Fraccion_Letras As Boolean , _
ByVal Fraccion As String, _
ByVal Texto_Inicial As String, _
ByVal Texto_Final As String, _
ByVal Estilo As Integer) As String
Dim strLetras As String
Dim NumTmp As String
Dim intFraccion As Integer
strLetras = Texto_Inicial
'Convertimos a positivo si es negativo
Numero = Abs(Numero)
NumTmp = Format(Numero, "000000000000000.00")
If Numero < 1 Then
strLetras = strLetras & "cero " & Plural(Moneda) & " "
Else
strLetras = strLetras & NumLet(Val(Left(NumTmp, 15)))
If Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
strLetras = strLetras & Moneda & " "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
strLetras = strLetras & "de " & Plural(Moneda) & " "
Else
strLetras = strLetras & Plural(Moneda) & " "
End If
End If
If Fraccion_Letras Then
intFraccion = Val(Right(NumTmp, 2))
Select Case intFraccion
Case 0
strLetras = strLetras & "con cero " & Plural(Fraccion)
Case 1
strLetras = strLetras & "con un " & Fraccion
Case Else
strLetras = strLetras & "con " & NumLet(Val(Right(NumTmp, 2))) & Plural(Fraccion)
End Select
Else
strLetras = strLetras & Right(NumTmp, 2)
End If
strLetras = strLetras & Texto_Final
Select Case Estilo
Case 1
strLetras = UCase(strLetras)
Case 2
strLetras = LCase(strLetras)
Case 3
strLetras = strLetras 'StrConv(strLetras, vbProperCase)
End Select
Numeros_Letras = strLetras
End Function
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
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
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
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), 1)
If pos > 0 Then
strPal = Palabra & "s"
Else
strPal = Palabra & "es"
End If
End If
Plural = strPal
End Function
Para probarlo colocamos una cantidad y luego ejecutamos los siguientes ejemplos para determinar cual es el que nos conviene más:
=NUMEROS_LETRAS(A1; "Bolívar";1; "céntimo"; ""; "";1)
=NUMEROS_LETRAS(A1; "Bolívar";1; "céntimo"; ""; "/100 CTMS";1)
=NUMEROS_LETRAS(A1; "Bolívar";0; "céntimo"; "Cantidad: "; "/100";1)
=NUMEROS_LETRAS(A1; "Bolívar";0; "céntimo"; "importe con letra: "; "/100";1)
=NUMEROS_LETRAS(A1; "Bolívar";1; "céntimo"; "importe con letra: "; "";1)
Esos ejemplos nos darán el siguiente resultado:
Explicación de los argumentos pasados a la Función Numeros_Letras:
Este código fue probado en:
Muchas Gracias y espero que les sea útil ésta Información.
'*************************************************************************************************
' FUNCION PARA CONVERTIR NUMEROS A LETRAS
'
' Copyright (C) 2005 Mauricio Baeza Servin
' Este programa es software libre. Puede redistribuirlo y/o modificarlo bajo los términos de la
' Licencia Pública General de GNU según es publicada por la Free Software Foundation, bien de la
' versión 2 de dicha Licencia o bien (según su elección) de cualquier versión posterior.
'
' Este programa se distribuye con la esperanza de que sea útil, pero SIN NINGUNA GARANTÍA, incluso
' sin la garantía MERCANTIL implícita o sin garantizar la CONVENIENCIA PARA UN PROPÓSITO PARTICULAR.
' Véase la Licencia Pública General de GNU para más detalles.
'
' Debería haber recibido una copia de la Licencia Pública General junto con este programa. Si no ha
' sido así, escriba a la Free Software Foundation, Inc., en 675 Mass Ave, Cambridge, MA 02139, EEUU.
'
' Mauricio Baeza - mauricio@correolibre.net
'
'*************************************************************************************************
'Hago uso de variables bastante explicitas para facilitar la lectura del codigo
'Los comentarios cumplen y complementan la misma funcion
'Ultima modificacion Octubre del 2002
'Argumentos:
'Numero = Valor que deseamos convertir en texto
'Moneda = es el nombre de la moneda a mostrar
'Fraccion_Letras = Verdadero para que la fraccion de la moneda
' tambien la convierta a letras
'Fraccion = Es el nombre de la fraccion de la moneda
'Texto_Inicial = Cualquier texto que quieras al principio del resultado
'Texto_Final = Cualquier texto que quieras al finla del resultado
'Estilo = Formato de salida
' 1 = MAYUSCULAS
' 2 = minusculas
' 3 = Tipo Titulo
'Los valores negativos los convierte a positivos
'El valor minimo en 0, el valor maximo es 9,999,999,999,999.99
Function Numeros_Letras(ByVal Numero As Double, _
ByVal Moneda As String, _
ByVal Fraccion_Letras As Boolean , _
ByVal Fraccion As String, _
ByVal Texto_Inicial As String, _
ByVal Texto_Final As String, _
ByVal Estilo As Integer) As String
Dim strLetras As String
Dim NumTmp As String
Dim intFraccion As Integer
strLetras = Texto_Inicial
'Convertimos a positivo si es negativo
Numero = Abs(Numero)
NumTmp = Format(Numero, "000000000000000.00")
If Numero < 1 Then
strLetras = strLetras & "cero " & Plural(Moneda) & " "
Else
strLetras = strLetras & NumLet(Val(Left(NumTmp, 15)))
If Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
strLetras = strLetras & Moneda & " "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
strLetras = strLetras & "de " & Plural(Moneda) & " "
Else
strLetras = strLetras & Plural(Moneda) & " "
End If
End If
If Fraccion_Letras Then
intFraccion = Val(Right(NumTmp, 2))
Select Case intFraccion
Case 0
strLetras = strLetras & "con cero " & Plural(Fraccion)
Case 1
strLetras = strLetras & "con un " & Fraccion
Case Else
strLetras = strLetras & "con " & NumLet(Val(Right(NumTmp, 2))) & Plural(Fraccion)
End Select
Else
strLetras = strLetras & Right(NumTmp, 2)
End If
strLetras = strLetras & Texto_Final
Select Case Estilo
Case 1
strLetras = UCase(strLetras)
Case 2
strLetras = LCase(strLetras)
Case 3
strLetras = strLetras 'StrConv(strLetras, vbProperCase)
End Select
Numeros_Letras = strLetras
End Function
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
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
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
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), 1)
If pos > 0 Then
strPal = Palabra & "s"
Else
strPal = Palabra & "es"
End If
End If
Plural = strPal
End Function
Guardamos el macro.
Para probarlo colocamos una cantidad y luego ejecutamos los siguientes ejemplos para determinar cual es el que nos conviene más:
=NUMEROS_LETRAS(A1; "Bolívar";1; "céntimo"; ""; "";1)
=NUMEROS_LETRAS(A1; "Bolívar";1; "céntimo"; ""; "/100 CTMS";1)
=NUMEROS_LETRAS(A1; "Bolívar";0; "céntimo"; "Cantidad: "; "/100";1)
=NUMEROS_LETRAS(A1; "Bolívar";0; "céntimo"; "importe con letra: "; "/100";1)
=NUMEROS_LETRAS(A1; "Bolívar";1; "céntimo"; "importe con letra: "; "";1)
Esos ejemplos nos darán el siguiente resultado:
Explicación de los argumentos pasados a la Función Numeros_Letras:
- El primer campo dentro de la función corresponde a la celda a convertir.
- El segundo campo corresponde a la moneda a utilizar. (En mi caso Venezuela, la moneda es el Bolívar).
- El tercer campo indica si se coloca la palabra "CON" antes de los decimales (0: No, 1: Si).
- El cuarto campo corresponde a la parte decimal de la moneda correspondiente al país. (En mi Caso: Venezuela, utilizamos céntimos).
- El quinto campo se coloca lo que quiere que vaya adelante de la Cifra Convertida.
- El sexto campo se coloca lo que quiere que vaya al final de la Cifra Convertida.
- El Séptimo campo se coloca si quiere la salida de la conversión en 1: Mayúscula, 2: Minúscula.
- Cada Campo debe ir separado por Punto y Coma ";"
- En caso de que se requiera omitir algún campo Alfanumérico (los que se encuentra en comillas dobles " xxxxx") se debe borrar el contenido pero se debe dejar las dos comillas dobles "".
Este código fue probado en:
Muchas Gracias y espero que les sea útil ésta Información.