Esporta una tabella come PDF

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


    Descrizione

    Questa macro esporta in PDF un foglio di Calc. Notate che questo si può fare senza bisogno di una macro, con File ▸ Esporta nel formato PDF ... ed attivando "Selezione/Fogli selezionati". Comunque può essere conveniente automatizzare/personalizzare questo processo con una macro, come di seguito illustrato.

    Questa soluzione è indipendente dal sistema operativo.

    Tutte le aree di stampa vengono cancellate, quindi la zona del foglio utilizzata viene impostata come area di stampa ed esportata in PDF.

    Eseguite la procedura Main e specificate il nome del foglio all'interno delle virgolette.

    Quando la macro è pronta all'uso, avviatela semplicemente all'interno di un file di Calc, come quello di esempio che trovate qui in calce.

    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
    
    ' Devono ancora essere dichiarate le variabili con Dim per far si che l'opzione esplicita (^) funzioni...
    ' A parte ciò la macro è funzionante.
    
    
    Sub Main()
    
        ExportToPDF ("Foglio 1")  ' put Calc sheet name here
    
    End Sub ' Main
    
    
    Sub ExportToPDF (sSheetName As String)
    
        MsgBox "Scegliete il percorso in cui esportare il PDF"
        sPath = GetPath
    
        If sPath = "" Then
            MsgBox "Nessun percorso valido.", 16, "Errore"
            GoTo Section1
        End If
    
        Section0:
        sStandard = "PDF_Export_" & sSheetName  & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")
    
        sName=InputBox ("Inserite un nome " & Chr(10) & _
                    "per il PDF." , "Nome del PDF", sStandard )
        If sName="" Then
            nVar = MsgBox ("Non avete inserito un nome. " & Chr(10) & _
                        "Inserite un nome. " & Chr(10) & _
                        "Se fate clic su ""Annulla"", " & Chr(10) & _
                        "l'esportazione verrà annullata.", 1, "Errore")
            If nVar = 1 Then   ' È stato premuto OK
                GoTo Section0
            Else
                GoTo Section1
            End If
        End If
    
        sFileName= sName & ".pdf"
        If FileExists(sPath & sFileName) Then
            nVar=MsgBox ("Il file esiste già. " & Chr(10) & _
                        "Sostituire il file? " & Chr(10) & _
                        Chr(10) & _
                        "Se fate clic su ""Annulla"", " & Chr(10) & _
                        "l'esportazione verrà annullata." & Chr(10) & _
                        "Se fate clic su ""No""," & Chr(10) & _
                        "potrete indicare un altro nome per il file.", 3, "Errore")
            Select Case nVar
                Case 2        ' È stato premuto Annulla
                    GoTo Section1
                Case 6        ' È stato premuto Si
                Case 7        ' È stato premuto No
                    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 "Il PDF è stato creato con successo." , 0, "ExportToPDF()"
    
        Section1:
            ThisComponent.UnlockControllers
            ThisComponent.removeActionLock
    
    End Sub ' ExportToPDF()
    
    
    Sub Delete_PrintAreas()
        '''Cancella tutte le aree di stampa.'''
    
        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)
        '''Imposta l'area di stampa.'''
    
        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
        '''Restituisce il numero intero dell'ultima riga usata.'''
    
        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
        '''Restituisce il numero dell'ultima colonna di un'area di dati adiacenti all'interno di un foglio.'''
    
        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
        '''Restituisce il percorso.'''
    
        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"   ' visualizza solamente i contenuti di Form.Fields
        args1(0).Value= TRUE
        args1(1).Name = "Printing"           ' non avete bisogno di questo
        args1(1).Value= 0                    ' in questo punto possono essere aggiunte ulteriori opzioni
        
        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"
        ' Sarà esportata solamente l'area di stampa selezionata.
        args2(2).Value = TRUE
        
        ThisComponent.storeToURL(sFileName,args2())
    
    End Sub ' export_pdf

    File ODS di esempio con la macro