Jump to content

Macros/Calc/016/nl

From The Document Foundation Wiki
This page is a translated version of the page Macros/Calc/016 and the translation is 100% complete.


Beschrijving

Met deze macro wordt een Calc-blad geëxporteerd naar een PDF. Merk op dat dit zonder macro kan worden gedaan, door Bestand ▸ Exporteren naar PDF... 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

ODS-bestand om macro te testen