Macros/Calc/016

From The Document Foundation Wiki
< Macros‎ | Calc
Jump to: navigation, search
This page is a translated version of the page Macros/Calc/016 and the translation is 100% complete.

Other languages:
English • ‎español • ‎français • ‎italiano • ‎português do Brasil

Descripción

Esta macro exporta una hoja de cálculo de Calc a PDF. Nótese que esto puede llevarse a cabo sin ayuda de las macros, tan solo vaya al menú Archivo ▸ Exportar a PDF… y en el diálogo Opciones de PDF seleccione Intervalo > Selección/hojas seleccionadas.

Sin embargo, puede ser deseable automatizar o personalizar este proceso a través de una macro, como se muestra abajo:

La solución no depende del sistema operativo que se use para ejecutar LibreOffice.

Todas los intervalos de impresión preexistentes en el libro de cálculo serán borrados. Después se definirá un nuevo intervalo de impresión con el área seleccionada. Finalmente se hará la exportación a PDF.

Ejecute la subrutina Main y especifique entre comillas el nombre de la hoja.

Después de eso, la macro está lista para usarse. Simplemente ejecute la macro desde el libro de Calc, como la que se incluye más abajo.

Código en LibreOffice Basic

' Copyright (c) 2011 Frieder Delor, Mailto: Einfach hier im Forum anschreiben :-)
' The function GetPath() is originally from:  Copyright (c) 2011 Volker Lenhardt
' This program is free software you can redistribute it and/or modify it under
' the terms of the GNU General Public License as published by the Free Software
' Foundation; either version 2 of the License, or (at your option) any later
' version.

' This program is distributed in the hope that it will be useful, but WITHOUT
' ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
' FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

' You should have received a copy of the GNU General Public License along with
' this program; if not, write to the Free Software Foundation, Inc., 59 Temple
' Place, Suite 330, Boston, MA 02111-1307 USA



'Option Explicit

' Aun es necesario declarar algunas Dim, de manera que Option Explicit funcione…


Sub Main()

    ExportToPDF ("Hoja1")  ' put Calc sheet name here

End Sub ' Main


Sub ExportToPDF (sSheetName As String)

    MsgBox "Elija la ruta en donde se guardará el PDF resultante"
    sPath = GetPath

    If sPath = "" Then
        MsgBox "No es una ruta válida para archivos.", 16, "Error"
        GoTo Section1
    End If

    Section0:
    sStandard = "PDF_Export_" & sSheetName  & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")

    sName=InputBox ("Por favor proporcione un nombre " & Chr(10) & _
                "para el PDF resultante." , "Nombre del PDF", sStandard )
    If sName="" Then
        nVar = MsgBox ("No ha proporcionado un nombre. " & Chr(10) & _
                    "Por favor proporcione un nombrepara el PDFresultante. " & Chr(10) & _
                    "Si pulsa el botón ""Cancelar"", " & Chr(10) & _
                    "el proceso de exportación se abortará.", 1, "Error")
        If nVar = 1 Then   ' Ha pulsado el botón ""OK""
            GoTo Section0
        Else
            GoTo Section1
        End If
    End If

    sFileName= sName & ".pdf"
    If FileExists(sPath & sFileName) Then
        nVar=MsgBox ("El archivo ya existe. " & Chr(10) & _
                    "¿Remplazo el archivo existente? " & Chr(10) & _
                    Chr(10) & _
                    "Si pulsa el botón ""Cancelar"", " & Chr(10) & _
                    "el proceso de exportación a PDF se abortará." & Chr(10) & _
                    "Si pulsa el botón ""No""," & Chr(10) & _
                    "podrá proporcionar otro nombre de archivo.", 3, "Error")
        Select Case nVar
            Case 2        ' Ha pulsado el botón ""Cancelar""
                GoTo Section1
            Case 6        ' Ha pulsado el botón ""Sí""
            Case 7        ' Ha pulsado el botón ""No""
                GoTo Section0
        End Select
    End If

    ThisComponent.addActionLock
    ThisComponent.LockControllers
    oDoc = ThisComponent
    oSheets = oDoc.Sheets
    oSheet1 = oDoc.Sheets.getByName(sSheetName)
    Delete_PrintAreas

    For n = 0 To oSheets.getCount - 1
        oSheet=oDoc.Sheets(n)
        If oSheet.Name= sSheetName Then
            lEndCol= GetLastUsedColumn(oSheet1)
            lEndRow=GetLastUsedRow(oSheet1)
            Set_PrintAreas (n ,0 ,0 ,lEndCol ,lEndRow)
        End If
    Next

    export_pdf(sPath & sFileName)
    Delete_PrintAreas
    MsgBox "El archivo PDF fue exitosamente creado." , 0, "ExportToPDF()"

    Section1:
        ThisComponent.UnlockControllers
        ThisComponent.removeActionLock

End Sub ' ExportToPDF()


Sub Delete_PrintAreas()
    '''Elimine todas las áreas de impresión.'''

    oDoc = ThisComponent
    oSheet = oDoc.Sheets(0)
    For n =0 To oDoc.Sheets.getCount - 1
        oDoc.Sheets(n).setPrintAreas(Array ())
    Next
    
End Sub ' Delete_PrintAreas()


Sub Set_PrintAreas (nSheet As Integer, lStartCol As Long, lStartRow As Long, lEndCol As Long, lEndRow As Long)
    '''Define el área de impresión.'''

    Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
    oDoc = ThisComponent
    oSheet = oDoc.Sheets(nSheet)
    CellRangeAddress.Sheet = nSheet
    CellRangeAddress.StartColumn = lStartCol
    CellRangeAddress.StartRow = lStartRow
    CellRangeAddress.EndColumn = lEndCol
    CellRangeAddress.EndRow = lEndRow
    aPrintAreas() = Array (CellRangeAddress)
    oSheet.setPrintAreas(aPrintAreas())
    
End Sub ' Set_PrintAreas


Function GetLastUsedRow(oSheet As Object) As Integer
    '''Devuelve un número entero que corresponde a la última fila con datos.'''

    Dim oCell
    Dim oCursor
    Dim aAddress
    
    oCell = oSheet.getCellByPosition(0, 0)
    oCursor = oSheet.createCursorByRange(oCell)
    oCursor.gotoEndOfUsedArea(True)
    aAddress = oCursor.RangeAddress
    GetLastUsedRow = aAddress.EndRow

End Function ' GetLastUsedRow


Function GetLastUsedColumn(oSheet As Object) As Long
    '''Devuelve el número de la última columna dentro de un intervalo de datos en una hoja de cálculo.'''

    Dim oCell
    Dim oCursor
    Dim aAddress
    
    oCell = oSheet.getCellByPosition(0, 0)
    oCursor = oSheet.createCursorByRange(oCell)
    oCursor.gotoEndOfUsedArea(True)
    aAddress = oCursor.RangeAddress
    GetLastUsedColumn = aAddress.EndColumn

End Function ' GetLastUsedColumn


Function GetPath() As String
    '''Devuelve la ruta a un archivo.'''

    Dim oPathSettings, oFolderDialog
    Dim sPath As String
    
    oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")
    sPath = oPathSettings.Work
    oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
    oFolderDialog.SetDisplayDirectory(sPath)
    If oFolderDialog.Execute() = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
        sPath = oFolderDialog.GetDirectory
    Else
        GetPath = ""
        Exit Function
    End If

    If Right(sPath, 1) <> "/" Then sPath = sPath & "/"

    GetPath = sPath

End Function ' GetPath()


Sub export_pdf (sFileName As String)
    
    Dim args1(1)    As New com.sun.star.beans.PropertyValue
    
    args1(0).Name = "ExportFormFields"   ' Solo muestra el contenido de Forms.Fields (campos de formulario)
    args1(0).Value= TRUE
    args1(1).Name = "Printing"           ' No necesita que
    args1(1).Value= 0                    ' más opciones puedan ser añadidas aquí
    
    Dim args2(2) As New com.sun.star.beans.PropertyValue
    
    args2(0).Name = "FilterName"
    args2(0).Value = "calc_pdf_Export"
    args2(1).Name = "FilterData"
    args2(1).Value = args1
    args2(2).Name = "SelectionOnly"
    ' Solo el área de impresión seleccionada será exportada a PDF.
    args2(2).Value = TRUE
    
    ThisComponent.storeToURL(sFileName,args2())

End Sub ' export_pdf

Documento ODS para probar la macro