Macros/Calc/016

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


    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 la zona 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 la zona de impresión seleccionada se exportará a PDF.
        args2(2).Value = TRUE
        
        ThisComponent.storeToURL(sFileName,args2())
    
    End Sub ' export_pdf

    Documento ODS para probar la macro