Esporta una tabella come PDF

TDF LibreOffice Document Liberation Project Blog comunitari Weblate Nextcloud Redmine Ask LibreOffice Donazione

• Pagina principale
• Sviluppo
• Design
• Controllo qualità
• Eventi
• Documentazione
• Sito web
• Traduzione
• Accessibilità
• Commerciale
• Inclusione
• Aiuto

• Macro
• Macro generiche
• Macro per Writer
• Macro per Calc
• Macro per Impress
• Macro per Draw
• Macro per Base
• Macro per Math
• Basic/Python

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

• Scaricate il file ODS che contiene questa macro