martes, 3 de julio de 2012

Función para convertir de número a letras en LibreOffice Calc con Macros

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:

Option Explicit
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



11 comentarios:

  1. Lo pasa bien, pero los decimales lo redondea, Se puede corregir esto.

    ResponderEliminar
  2. Gran trabajo, gracias!

    Para 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.

    ResponderEliminar
  3. ¡Excelente, muchas gracias! Sería bueno arreglar la linea

    unction Centena(ByVal uni As Integer, ByVal dec As

    Le hace falta la "F".

    De nuevo muchas gracias.

    ResponderEliminar
  4. Podrian publicar el codigo completo para que no se redondee y se use con formato Mexico? Gracias.

    ResponderEliminar
  5. Hola 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.

    ResponderEliminar
  6. hola Juankof
    Podrí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

    ResponderEliminar
  7. Ya me di cuenta donde estaba el error.
    Puede realizarlo
    Gracias!!

    ResponderEliminar
  8. en linea 13 me da error de "el argumento no es opcional"

    ResponderEliminar

Gracias por tus comentarios...!