Macros/Calc/016/nl
Appearance
TDF LibreOffice Document Liberation Project Blogs gemeenschap Weblate Nextcloud Redmine Ask LibreOffice Doneren
Beschrijving
Met deze macro wordt een Calc-blad geëxporteerd naar een PDF. Merk op dat dit zonder macro kan worden gedaan, door
▸ en kies "Selectie/Geselecteerde blad(en)". Het kan echter wenselijk zijn om dit proces te automatiseren/aanpassen via een macro, zoals hieronder weergegeven.Deze oplossing is onafhankelijk van het besturingssysteem.
Alle afdrukbereiken worden verwijderd, vervolgens wordt het gebruikte gebied van het blad gedefinieerd als afdrukbereik en vervolgens geëxporteerd als PDF.
Voer de subroutine Main
uit en geef de naam van het blad op in de aanhalingstekens.
Daarna is de macro klaar voor gebruik. Start de macro gewoon vanuit een Calc-bestand, zoals het onderstaande bestand.
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
' Dims moet nog steeds geïmplementeerd worden, zodat de optie (^) expliciet werkt...
' Anders dan dat de macro werkt.
Sub Main()
ExportToPDF ("Blad1") ' put Calc sheet name here
End Sub ' Main
Sub ExportToPDF (sSheetName As String)
MsgBox "Kies een bestandspad waar u de PDF naar wilt exporteren"
sPath = GetPath
If sPath = "" Then
MsgBox "Geen geldig bestandspad.", 16, "Fout"
GoTo Section1
End If
Section0:
sStandard = "PDF_Export_" & sSheetName & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")
sName=InputBox ("Geef a.u.b. een naam " & Chr(10) & _
"voor het PDF-bestand." , "PDF-naam", sStandard )
If sName="" Then
nVar = MsgBox ("U heeft geen naam opgegeven. " & Chr(10) & _
"Geeft het a.u.b. een naam. " & Chr(10) & _
"Als u klikt op ""Afbreken"", " & Chr(10) & _
"wordt het exporteren afgebroken.", 1, "Fout")
If nVar = 1 Then ' Geklikt op OK
GoTo Section0
Else
GoTo Section1
End If
End If
sFileName= sName & ".pdf"
If FileExists(sPath & sFileName) Then
nVar=MsgBox ("Het bestand bestaat al. " & Chr(10) & _
"Moet het bestand worden vervangen? " & Chr(10) & _
Chr(10) & _
"Als u klikt op ""Afbreken"", " & Chr(10) & _
"wordt het exporteren afgebroken." & Chr(10) & _
"Als u klikt op ""Nee""," & Chr(10) & _
"kunt u een andere bestandsnaam opgeven.", 3, "Fout")
Select Case nVar
Case 2 ' Er is gedrukt op Afbreken
GoTo Section1
Case 6 ' Er is gedrukt op Ja
Case 7 ' Er is gedrukt op Nee
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 "Het PDF-bestand is aangemaakt." , 0, "ExportToPDF()"
Section1:
ThisComponent.UnlockControllers
ThisComponent.removeActionLock
End Sub ' ExportToPDF()
Sub Delete_PrintAreas()
'''Alle afdrukgebieden verwijderen.'''
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)
'''Afdrukgebied definiëren.'''
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
'''Retourneert het getal van de laatst gebruikte rij.'''
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
'''Geeft het nummer van de laatste kolom van een doorlopend gegevensbereik in een blad.'''
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
'''Geeft het pad.'''
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" ' de inhoud tonen van Form.Fields
args1(0).Value= TRUE
args1(1).Name = "Printing" ' je hebt dat niet nodig
args1(1).Value= 0 ' hier kunnen meer opties worden toegevoegd
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"
' Alleen het geselecteerde afdrukgebied wordt geëxporteerd.
args2(2).Value = TRUE
ThisComponent.storeToURL(sFileName,args2())
End Sub ' export_pdf