Eine Tabelle als PDF exportieren

TDF LibreOffice Document Liberation Project Community Blogs Weblate Nextcloud Redmine Ask LibreOffice Spende

• Start
• Entwicklung
• Gestaltung
• QA
• Events
• Dokumentation
• Webseite
• Lokalisierung
• Barrierefreiheit
• Marketing
• Diversität
• Wiki Hilfe

• Makros
• Allgemeine Makros
• Makros für Writer
• Makros für Calc
• Makros für Impress
• Macros für Draw
• Makros für Base
• Makros für Math
• Basic/Phyton

Beschreibung

Dieses Makro exportiert ein Calc Tabellenblat als PDF. Das kann auch über Datei ▸ Als PDF exportieren... und über "Auswahl/ausgewählte Blätter" erledigt werden. Trotzdem kann es nötig werden, diesen Vorgang über ein Makro zu automatisieren.

Diese Lösung ist Betriebssystem unabhängig.

Alle Druckbereiche werden gelöscht, dann wird der markierte Bereich des Blattes als Druckbereich definiert und dann als PDF exportiert.

Das Main Unterprogramm wird gestartet und der Blattname in den Anführungszeichen angegeben.

Damit ist das Makro betriebsbereit. Das Makro wird aus einer einfachen Calc-Datei gestartet, so wie unten angefügt.

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

' Weitere Dims sind immer noch nötig, so dass (^) Option explizit funktioniert...
' Andererseits arbeitet das Makro.


Sub Main()

    ExportToPDF ("Tabelle1")  ' put Calc sheet name here

End Sub ' Main


Sub ExportToPDF (sSheetName As String)

    MsgBox "Zielpfad für das PDF auswählen"
    sPath = GetPath

    If sPath = "" Then
        MsgBox "kein gültiger Dateipfad", 16, "Fehler"
        GoTo Section1
    End If

    Section0:
    sStandard = "PDF_Export_" & sSheetName  & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")

    sName=InputBox ("Bitte einen Namen " & Chr(10) & _
                "für die PDF-Datei angeben." , "PDF-Datei", sStandard )
    If sName="" Then
        nVar = MsgBox ("Sie haben keinen Namen angegeben. " & Chr(10) & _
                    "Bitte geben Sie einen Namen an. " & Chr(10) & _
                    "Wenn Sie auf ""Abbrechen"" klicken, " & Chr(10) & _
                    "stoppt der Export.", 1, "Fehler")
        If nVar = 1 Then   ' OK wurde geklickt
            GoTo Section0
        Else
            GoTo Section1
        End If
    End If

    sFileName= sName & ".pdf"
    If FileExists(sPath & sFileName) Then
        nVar=MsgBox ("Die Datei existiert bereits. " & Chr(10) & _
                    "Soll die Datei ersetzt werden? " & Chr(10) & _
                    Chr(10) & _
                    "Wenn Sie auf ""Abbrechen"" klicken, " & Chr(10) & _
                    "stoppt der Export." & Chr(10) & _
                    "Wenn Sie auf ""Nein"" klicken," & Chr(10) & _
                    "können Sie einen anderen Namen angeben.", 3, "Fehler")
        Select Case nVar
            Case 2        ' Abbrechen wurde gewählt
                GoTo Section1
            Case 6        ' Ja wurde gewählt
            Case 7        ' Nein wurde gewählt
                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 "Das PDF wurde erfolgreich erstellt." , 0, "ExportToPDF()"

    Section1:
        ThisComponent.UnlockControllers
        ThisComponent.removeActionLock

End Sub ' ExportToPDF()


Sub Delete_PrintAreas()
    '''Alle Druckbereiche werden gelöscht.'''

    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)
    '''Der Druckbereich wird definiert.'''

    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
    '''Gibt die letzte verwendete Zeile als Integer zurück.'''

    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
    '''Gibt die Nummer der letzten Spalte eines laufenden Datenbereichs in einem Blatt zurück.'''

    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
    '''Gibt den Pfad zurück.'''

    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"   ' zeigt nur den Inhalt der Form.Fields
    args1(0).Value= TRUE
    args1(1).Name = "Printing"           ' das braucht niemand
    args1(1).Value= 0                    ' mehr Optionen können hier eingefügt werden
    
    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"
    ' Nur der ausgewählte Druckbereich wird exportiert werden.
    args2(2).Value = TRUE
    
    ThisComponent.storeToURL(sFileName,args2())

End Sub ' export_pdf

= ODS Datei, um das Makro zu testen

• Die ODS Datei mit dem Makro herunterladen