Export a Calc sheet as PDF

From The Document Foundation Wiki
< Macros‎ | Calc
Jump to navigation Jump to search
Other languages:
English • ‎español • ‎français • ‎italiano • ‎português do Brasil


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.


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

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

    oDoc = ThisComponent
    oSheets = oDoc.Sheets
    oSheet1 = oDoc.Sheets.getByName(sSheetName)

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

    export_pdf(sPath & sFileName)
    MsgBox "The PDF was successfully created." , 0, "ExportToPDF()"


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 ())
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)
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)
    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)
    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")
    If oFolderDialog.Execute() = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
        sPath = oFolderDialog.GetDirectory
        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

End Sub ' export_pdf

ODS file to test macro