Macros

From The Document Foundation Wiki
< Macros‎ | Calc‎ | 016
Jump to: navigation, search

Exporter une feuille en PDF

Cette 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.

Cette solution fonctionne indépendemment du système.

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.
option explicit

'==============================================================================
'Inspiré de:
'Copyright (c) 2011 Frieder Delor, Mailto: Einfach hier im Forum anschreiben :-)
'
'The funktion: 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
'==============================================================================


Sub Main
' Remplacer Feuille1 par le nom de feuille à exporter
ExportToPDF ("Feuille1")
end sub

Sub ExportToPDF (sTableNam As String)

dim oDoc as object, oSheets as object, oSheet as object, oPlage as object, oEnCours as object, oRanges as object
dim lEndCol as long, lEndRow as long, lCoord(1) as long
dim nVar as integer
dim sPath as string,sStandard as string, sName


oDoc = ThisComponent

oSheets = oDoc.Sheets

' Vérifie que le classeur contient une feuille de ce nom
if oDoc.Sheets.hasByName(sTableNam) then
        oSheet = oDoc.Sheets.getByName(sTableNam) 
' Choix du dossier dans lequel exporter le pdf
        sPath = GetPath
' Vérifie si l'utilisateur a choisi un dossier
        If sPath = "" Then
                msgbox "Vous n'avez pas sélectionné de dossier", 64, "Export interrompu"      
        else
' Creation d'un nom par défaut incluant la date & heure pour le pdf        
                sStandard = "PDF_Export_" & _
                                  Format(Now,"dd.mm.yyyy\_hh-mm") 
                sName = InputBox ("Donner un nom sans extension" & Chr(10) & _
                                "pour le PDF." , "Nom du PDF", sStandard )
' Si l'utilisateur n'a pas donné de nom
                If sName = "" Then
                        msgbox "Vous n'avez pas donné de nom pour le PDF", 64, "Export interrompu"
                else
' Si l'utilisateur a donné un nom ou gardé celui proposé par défaut    
                        sName = sName & ".pdf"
                        nVar = 0
' Vérifie que le fichier cible existe déjà ou non
' Si oui, possibilité d'écraser ou donner un autre nom                 
                        do while FileExists(sPath & sName) and nVar <> 2 and nVar <> 6
                                nVar = MsgBox ("Ce fichier existe déjà. " & Chr(10) & _
                                        "Voulez-vous le remplacer ? " & Chr(10) & _
                                        Chr(10) & _
                                        """Annuler"" pour arrêter l'export, " & Chr(10) & _
                                        """Non"" pour saisir un autre nom", 35, "Erreur")     
                                if nVar = 7 then
                                        sName = InputBox ("Donner un nom sans extension" & Chr(10) & _
                                                        "pour le PDF." , "Nom du PDF", sStandard )
                                        sName = sName & ".pdf"
                                end if
                        loop
                        
                        if nVar <> 2 then
                        
'                          oDoc.addActionLock
'                          oDoc.LockControllers

' Mémorise la sélection courante
                                oEnCours = oDoc.currentselection

' Vérifie si au moins une zone d'impression a été définie pour cette feuille
' Si oui on l'utilise, sinon on exporte toute la plage utilisée dans la feuille
                                if ubound(oSheet.PrintAreas) <> -1 then
' Création d'une instance "plage" vide qui permet de déselectionner
' (utile par ex. si l'utilisateur avait sélectionné un graphisme)                              
                                        oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
                                        oDoc.currentcontroller.activeSheet = oSheet
                                        oDoc.currentcontroller.select(oRanges)
                                else
                                        lCoord = GetLastUsed(oSheet)
                                        oPlage = oSheet.getCellRangeByPosition(0, 0, lCoord(0), lCoord(1))
                                        oDoc.currentcontroller.select(oPlage)
                                end if    
                                
                                export_pdf(sPath & sName)  

' Restaure la sélection avant export
                                oDoc.currentcontroller.select(oEnCours)

                                MsgBox "Le PDF a été créé." , 64, "Export PDF"
 
'                          oDoc.UnlockControllers 
'                          oDoc.removeActionLock

                        end if
                end if
        End If 
else
    MsgBox "Nom de feuille incorrect", 16, "Erreur"
end if

End sub  

'------------------------------------
Function GetLastUsed(oSheet as Object) 
Dim oCell as object, oCursor as object, oAddress as object
Dim lCoord(1) as long
        oCell = oSheet.getCellByPosition(0, 0)
        oCursor = oSheet.createCursorByRange(oCell)
        oCursor.gotoEndOfUsedArea(True)
        with oCursor.RangeAddress
                lCoord(0) = .EndColumn
                lCoord(1) = .EndRow
        end with  
        GetLastUsed = lCoord()
End Function

'----------------------------------
Function GetPath() As String
  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  

'------------------------------------
sub export_pdf (sFileName AS String)
 
dim propFich(2) as new com.sun.star.beans.PropertyValue
dim filterProps(0) as new com.sun.star.beans.PropertyValue
 
filterProps(0).Name = "Selection"
filterProps(0).Value = thisComponent.currentSelection

propFich(0).Name = "FilterName"
propFich(0).Value = "calc_pdf_Export"
propFich(1).Name = "FilterData"
propFich(1).Value = filterProps()

 
ThisComponent.storeToURL(sFileName,propFich())

end sub