Exporter une feuille en PDF

TDF LibreOffice Document Liberation Project Blogs communautaires Weblate Nextcloud Redmine Ask LibreOffice Donner

• Accueil
• Development
• Design
• QA
• Évènements
• Documentation
• Website
• Localisation
• Accessibility
• Marketing
• Diversity
• Aide

• Macros
• Macros générales
• Writer
• Calc
• Impress
• Draw
• Base
• Math
• Basic/Python

Description

Cette macro permet d'exporter une feuille de classeur au format PDF.

Cette solution fonctionne indépendemment du système.

Le macro permet d'exporter une feuille de classeur au format PDF, quelles que soient la sélection ou les zones d'impression définies pour les autres feuilles. Elle utilise les zones d'impression de la feuille si une ou plusieurs on été définies. Dans le cas contraire toute la feuille est exportée.

Le code doit être personnalisé en indiquant le nom de la feuille à exporter dans la procédure Sub Main.

La macro :

• demande le dossier de destination et le nom souhaité pour le PDF,
• vérifie l'existence du fichier (possibilité de changer de nom ou d'écraser le document existant),
• vérifie l'existence de zones d'impression pour la feuille,
  • si oui, utilisation des zones d'impression,
  • si non, récupération de l'adresse de la dernière cellule * utilisée puis sélection de toute la plage concernée,
• exporte le document.

Code

En 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

' Il faut encore implémenter les Dims pour que le Option Explicit  fonctionne...
' A part ça, la macro fonctionne.


Sub Main()

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

End Sub ' Main


Sub ExportToPDF (sSheetName As String)

    MsgBox "Choisissez le chemin du lieu d'exportation PDF"
    sPath = GetPath

    If sPath = "" Then
        MsgBox "Vous n'avez pas sélectionné de dossier", 16, "Export interrompu"
        GoTo Section1
    End If

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

    sName=InputBox ("Donner un nom sans extension " & Chr(10) & _
                "pour le PDF" , "Nom du PDF", sStandard )
    If sName="" Then
        nVar = MsgBox ("Vous n'avez pas donné de nom pour le PDF " & Chr(10) & _
                    "Veuillez donner un nom. " & Chr(10) & _
                    "Si vous cliquez sur "Annuler", " & Chr(10) & _
                    "l'exportation sera arrêtée.", 1, "Export interrompu")
        If nVar = 1 Then   ' OK a été cliqué
            GoTo Section0
        Else
            GoTo Section1
        End If
    End If

    sFileName= sName & ".pdf"
    If FileExists(sPath & sFileName) Then
        nVar=MsgBox ("Ce fichier existe déjà. " & Chr(10) & _
                    "Voulez-vous le remplacer ? " & Chr(10) & _
                    Chr(10) & _
                    "Si vous cliquez sur "Annuler", " & Chr(10) & _
                    "l'exportation sera arrêtée" & Chr(10) & _
                    "Si vous cliquez sur "Annuler"," & Chr(10) & _
                    "vous pourriez saisir un autre nom", 3, "Export interrompu")
        Select Case nVar
            Case 2        ' Annuler a été cliqué
                GoTo Section1
            Case 6        ' Oui a été cliqué
            Case 7        ' Non a été cliqué
                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 "Le PDF a été créé avec succès." , 0, "ExportToPDF()"

    Section1:
        ThisComponent.UnlockControllers
        ThisComponent.removeActionLock

End Sub ' ExportToPDF()


Sub Delete_PrintAreas()
    '''Supprimez toutes les zones d'impression.'''

    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)
    '''Définissez la zone d'impression.'''

    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
    '''Retourne l'entier de la dernière ligne utilisée.'''

    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
    '''Renvoie le numéro de la dernière colonne d'une série de données continues dans une feuille.'''

    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
    '''Rendra le chemin.'''

    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"   ' afficher le contenu du formulaire
    args1(0).Value= TRUE
    args1(1).Name = "Printing"           ' n'ai pas besoin de ca
    args1(1).Value= 0                    ' d'autres options pourraient être ajoutées ici
    
    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"
    ' <span lang="en" dir="ltr" class="mw-content-ltr">Only the selected printing Area will we exported.</span>
    args2(2).Value = TRUE
    
    ThisComponent.storeToURL(sFileName,args2())

End Sub ' export_pdf

Fichier ODT pour tester la macro

• Télécharger le fichier ODS pour exécuter les scripts exemples.