Export a table as PDF

From The Document Foundation Wiki
< Macros‎ | Calc
Jump to: navigation, search


This macro exports only one sheet to a PDF.

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.

The code has to be customized: the "Your Table name" in the procedure "Sub Main" has to be changed (only the bold part without quotes!).

After that the macro is ready to use. Simply start the macro from a Calc file.


REM  *****  BASIC  *****
'Copyright (c) 2011 Frieder Delor, Mailto: Einfach hier im Forum anschreiben :-)
'The funktion: 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 

'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
Sub Main
ExportToPDF ("Your Table name")
end sub
Sub ExportToPDF (sTableNam As String)
  sPath = GetPath
  If sPath = "" Then
    MsgBox "No valid file path.", 16, "Error"
    goTo Zeile1
  End If 
  sStandard = "PDF_Export_" & Format(Now, "hh-mm")& "Uhr_" & _
  sName=InputBox ("Please give a name " & Chr(10) & _
                  "for the PDF file." , "PDF Name", sStandard )
  If sName="" Then
    nVar=MsgBox ("You haven't provided 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 Zeile0
      goTo Zeile1
    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 'Cancle was pressed
      goTo Zeile1
    Case 6 'Yes was pressed
    Case 7 'No was pressed
      goTo Zeile0
    End Select 
  end if
  oDoc = ThisComponent
  oSheets = oDoc.Sheets
  oSheet1 =oDoc.Sheets.getByName(sTableNam) 
For n = 0 To oSheets.getCount - 1
  if oSheet.Name= sTableNam Then 
  lEndCol= GetLastUsedColumn(oSheet1)
    Set_PrintAreas (n ,0 ,0 ,lEndCol ,lEndRow)
  End if
  export_pdf(sPath & sFileName)  
  MsgBox "The PDF was successfully created." , 0, "PDF Export"

End sub
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
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
Function GetLastUsedRow(oSheet as Object) As Integer 
  Dim oCell
  Dim oCursor
  Dim aAddress
  oCell = oSheet.getCellByPosition(0, 0)
  oCursor = oSheet.createCursorByRange(oCell)
  aAddress = oCursor.RangeAddress
  GetLastUsedRow = aAddress.EndRow
End Function
REM Returns the number of the last column 
'of a continuous data range in a sheet.
Function GetLastUsedColumn(oSheet as Object) As Long
  Dim oCell
  Dim oCursor
  Dim aAddress

  oCell = oSheet.getCellByPosition(0, 0)
  oCursor = oSheet.createCursorByRange(oCell)
  aAddress = oCursor.RangeAddress
  GetLastUsedColumn = aAddress.EndColumn
End Function
Function GetPath() As String
  Dim  oPathSettings, oFolderDialog
  Dim sPath As String

    oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")
    sPath = oPathSettings.Work
    oFolderDialog = _
    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 
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