Hoy me encontré con un problema... Necesitaba pasar números a palabras, luego de indagar un poco encontré una función en Macros bastante sencilla de implementar.
1. Lo primero es Abrir nuestro LibreOffice Calc e ir a Herramientas -> Organizar Macros -> LibreOffice Basic...
2. Seleccionamos Macros de LibreOffice y posteriormente el nombre de nuestro documento y agregamos uno nuevo y le ponemos un nombre para identificar la macros.
3. Ahora en la ventana que nos aparece pegamos el siguiente código:
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
unction 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
4. Cerramos y queda guardada la función
5. Ahora para aplicar el valor a una celda solo debemos llamar a la función de la siguiente forma: =NumLet(celda)
6. Posible mente aparezca algún tipo de error, generalmente es por seguridad. Para solucionarlo vamos al menú Herramientas -> Opciones y el la ventana que aparece nos vamos al nivel de seguridad y presionamos en Seguridad de macros.
7. Ahora nos fijamos que esté en el nivel bajo y aceptamos.
Eso sería la forma ideal de poder transformar cualquier numero a letras en una planilla de calculo LibreOffice, con respecto a Ecxel no se si lo pasos son los mismos.
Editor:
Christian Muñoz
Lo pasa bien, pero los decimales lo redondea, Se puede corregir esto.
ResponderEliminarGran trabajo, gracias!
ResponderEliminarPara generar un formato como el siguiente ejemplo (usado en México):
"CIENTO DIEZ PESOS 00/100 M.N."
He modificado la función "Numeros_Letras" como en el siguiente fragmento:
If Fraccion_Letras Then
intFraccion = Val(Right(NumTmp, 2))
If Fraccion_Letras = 1 Then
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
If intFraccion < 10 Then
strLetras = strLetras & "0" & intFraccion & "/100 M.N."
Else
strLetras = strLetras & intFraccion & "/100 M.N."
Endif
EndIf
Else
strLetras = strLetras & Right(NumTmp, 2)
End If
De esta forma, si el argumento Fraccion_Letras es diferente de cero y además es igual a 2, el formato anterior es usado.
¡Excelente, muchas gracias! Sería bueno arreglar la linea
ResponderEliminarunction Centena(ByVal uni As Integer, ByVal dec As
Le hace falta la "F".
De nuevo muchas gracias.
Podrian publicar el codigo completo para que no se redondee y se use con formato Mexico? Gracias.
ResponderEliminarHola buen día soy nuevo en libre office, ya lo intente varias veces y no puedo hacerlo. sigo las instrucciones y no lo eh podido hacer, alguien me puede ayudar ?gracias.
ResponderEliminarhola Juankof
ResponderEliminarPodrías escribir la línea correctamente? Dónde lleva la "F"?
Me da error y no me transforma los números en letras. Ya modifiqué la seguridad en macros.
Gracias
Saludos
Ya me di cuenta donde estaba el error.
ResponderEliminarPuede realizarlo
Gracias!!
me manda error de sisntaxis se esparaba sub
ResponderEliminar¿LOGRASTE ARREGLAR EL FALLO? ME PASA LO MISMO.
Eliminarlinea 124 falta F de Function
ResponderEliminaren linea 13 me da error de "el argumento no es opcional"
ResponderEliminar