Macros/Calc/016

    From The Document Foundation Wiki
    < Macros‎ | Calc


    Description

    This macro exports a Calc sheet to a PDF. Note that this can be done without a macro, by File ▸ Export as PDF ..., and choosing "Selection/Selected sheet(s)". However it can be desirable to automate/customize this process via a macro, as shown below.

    This solution is operating system independent.

    All the print ranges are deleted, then the used area of the sheet is defined as print range, then exported as PDF.

    Run the Main subroutine, and specify the sheet name inside the quotes.

    After that the macro is ready to use. Simply start the macro from a Calc file, such as the one included below.

    Code

    In 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
    
    ' Still need to implement Dims so that (^) option explicit works...
    ' Other than that the macro is working.
    
    
    Sub Main()
    
        ExportToPDF ("Sheet1")  ' put Calc sheet name here
    
    End Sub ' Main
    
    
    Sub ExportToPDF (sSheetName As String)
    
        MsgBox "Choose path of where to export PDF"
        sPath = GetPath
    
        If sPath = "" Then
            MsgBox "No valid file path.", 16, "Error"
            GoTo Section1
        End If
    
        Section0:
        sStandard = "PDF_Export_" & sSheetName  & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")
    
        sName=InputBox ("Please give a name " & Chr(10) & _
                    "for the PDF file." , "PDF Name", sStandard )
        If sName="" Then
            nVar = MsgBox ("You did not provide a name. " & Chr(10) & _
                        "Please give a name. " & Chr(10) & _
                        "If you click On ""Cancel"", " & Chr(10) & _
                        "the export will be stopped.", 1, "Error")
            If nVar = 1 Then   ' OK was clicked
                GoTo Section0
            Else
                GoTo Section1
            End If
        End If
    
        sFileName= sName & ".pdf"
        If FileExists(sPath & sFileName) Then
            nVar=MsgBox ("The file already exists. " & Chr(10) & _
                        "Should the file replaced? " & Chr(10) & _
                        Chr(10) & _
                        "If you click On ""Cancel"", " & Chr(10) & _
                        "the export will be stopped." & Chr(10) & _
                        "If you click On ""No""," & Chr(10) & _
                        "you are able To provide another file name.", 3, "Error")
            Select Case nVar
                Case 2        ' Cancel was pressed
                    GoTo Section1
                Case 6        ' Yes was pressed
                Case 7        ' No was pressed
                    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 "The PDF was successfully created." , 0, "ExportToPDF()"
    
        Section1:
            ThisComponent.UnlockControllers
            ThisComponent.removeActionLock
    
    End Sub ' ExportToPDF()
    
    
    Sub Delete_PrintAreas()
        '''Delete all print areas.'''
    
        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 the print area.'''
    
        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
        '''Returns integer of last used row.'''
    
        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
        '''Returns the number of the last column of a continuous data range in a sheet.'''
    
        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
        '''Returns path.'''
    
        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"   ' just show the contents of the Form.Fields
        args1(0).Value= TRUE
        args1(1).Name = "Printing"           ' you don't need that
        args1(1).Value= 0                    ' more options could be added here
        
        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"
        ' Only the selected printing Area will we exported.
        args2(2).Value = TRUE
        
        ThisComponent.storeToURL(sFileName,args2())
    
    End Sub ' export_pdf

    ODS file to test macro