Export a table as PDF

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

Description

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.

Code

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 
'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
'==============================================================================
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 
  Zeile0:
  sStandard = "PDF_Export_" & Format(Now, "hh-mm")& "Uhr_" & _
                    Format(Now,"dd.mm.yyyy") 
  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
    Else
      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
  ThisComponent.addActionLock
  ThisComponent.LockControllers
  oDoc = ThisComponent
  oSheets = oDoc.Sheets
  oSheet1 =oDoc.Sheets.getByName(sTableNam) 
  Delete_PrintAreas
For n = 0 To oSheets.getCount - 1
  oSheet=oDoc.Sheets(n)
  if oSheet.Name= sTableNam 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, "PDF Export"

  Zeile1:
  ThisComponent.UnlockControllers 
  ThisComponent.removeActionLock
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 ())
  Next
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)
  oSheet.setPrintAreas(aPrintAreas())

End sub
'------------------------------------
Function GetLastUsedRow(oSheet as Object) As Integer 
  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
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)
  oCursor.gotoEndOfUsedArea(True)
  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 = _
          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 
'------------------------------------
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