Exporter la feuille d'un classeur au format PDF

Créée le: 13/11/2009

      Question posée

Je souhaiterais exporter une feuille Excel récapitulant la situation mensuelle de chaque agence et cela au format PDF.
J'ai 142 agences à exporter et manuellement c'est trop long!
En effet on pourrait utiliser le code suivant mais à chaque fois on a la fenêtre de dialogue de PDFCreator
qui s'affiche, puis il faut valider et ainsi de suite.
Pour votre info il existe également une version avec l'option Multi-Select (Voir en bas du document)

Sub PrintPDF()

   Application.ActivePrinter = "PDFCreator sur Ne00:"

   ActiveWindow.SelectedSheets.PrintOut Copies:= 1 , _

         ActivePrinter:= "PDFCreator sur Ne00:" , Collate:= True

End Sub

     
      Le problème posé en image
Premier export:

Second export:

Je dois changer le nom de l'agence, exporter en PDF, à nouveau changer le nom de l'agence et cela 142 fois.

      Méthode proposée

Il nous faut d'abord un logiciel pour exporter en format PDF:
  Nous allons utiliser le logiciel PDFCreator - Licence: GNU General Public License (GPL)
  Il est libre de droit et propose une référence VBA.

  Lien pour télécharger: PDFCreator
     
     Le cahier des charges ...
     1 - Possibilté d'exporter soit seulement une agence, soit toutes les agences simultanément.
     2 - Suivre en temps réel l'export de toutes les agences.
     3 - Visualiser le pourcentage d'avancement.
     4 - Exporter les fichiers PDF dans un répertoire Export (de niveau inférieur à celui du programme).
     La solution proposée ...
       Pour cela on va utiliser un formulaire ...
         1.1 Pour éventuellment gérer les agences dans une ComboBox
         1.2 Pour suivre en temps réel l'export de toutes les agences
         1.3 Afficher le pourcentage d'avancement

       L'aperçu du formulaire en cours de fonctionnement ...

     

     Le formulaire en mode création avec le nom des contrôles ...
     
    Je vous donne le détail du code VBA ci-dessous mais je vous mets le
    fichier Excel à disposition pour l'adapter à vos besoins.
Le code du module

Sub ExportPDF()

   Sheets( "Export PDF" ).Activate

   Application.ScreenUpdating = False

   Call CreationRep

   frmPDFCreator.Show

End Sub

Sub CreationRep()

   Dim x As String , strPath As String

   On Error Resume Next

   strPath = ActiveWorkbook.Path & "\Export"

   x = GetAttr (strPath) And 0

   If Err <> 0 Then

      MkDir strPath

   End If

End Sub

Le code du formulaire

Private Declare Sub Sleep Lib "kernel32.dll" ( ByVal dwMilliseconds As Long )

' Ajouter la référence à PDFCreator

Private WithEvents PDFCreator1 As PDFCreator.clsPDFCreator

Private ReadyState As Boolean , DefaultPrinter As String

Public J As Integer , I As Integer

Public nbLgn As Integer

Dim PctDone As Single

Private Sub UserForm_Initialize()

   If Len (ActiveWorkbook.Path) = 0 Then

      MsgBox "Please save the document first!" , vbExclamation

      End

   End If

   Set PDFCreator1 = New clsPDFCreator

   With PDFCreator1

      If .cStart( "/NoProcessingAtStartup" ) = False Then

         cmdExecute.Enabled = False

         AddStatus "Impossible d'initialiser PDFCreator."

         Exit Sub

      End If

   End With

   AddStatus "PDFCreator est initialisé."

   Me.OptionButton1.Value = 1

   Sheets( "Objectif Standard" ).Activate

   Range([A1], [A65536].End(xlUp).Offset(- 3 , 0 )).Select

   B = Selection.Value

   For I = 1 To UBound (B)

      Me.cboAgences.AddItem B(I, 1 )

   Next I

   Me.FrameProgress.Visible = False

   frmPDFCreator.LabelProgress.Width = 0

   Sheets( "Export PDF" ).Activate

End Sub

Private Sub cmdExecute_Click()

   Dim outName As String , I As Long

   Dim Plg As Range

   cmdExecute.Enabled = False

   Application.ScreenUpdating = False

   If OptionButton1.Value = True Then

      Me.FrameProgress.Visible = True

      Sheets( "Objectif Standard" ).Activate

      Range([A1], [A65536].End(xlUp).Offset(- 3 , 0 )).Select

      B = Selection.Value

      Sheets( "Export PDF" ).Activate

      [A1].Select

      Application.ScreenUpdating = False

      Sheets( "Export PDF" ).Activate

      Application.ScreenUpdating = True

      Range( "A1:AA29" ).Select

      Me.cmdAnnuler.Enabled = False

      nbLgn = UBound (B)

      For I = 1 To UBound (B)

         Application.ScreenUpdating = True

         Sheets( "Export PDF" ).Cells( 1 , 1 ).Value = B(I, 1 )

         Filename = Application.Substitute(Sheets( "Export PDF" ).Cells( 1 , 1 ).Value, "/" , "_" , 1 )

         Application.ScreenUpdating = False

         Range( "A1:AA29" ).Select

         With PDFCreator1

            .cOption( "UseAutosave" ) = 1

            .cOption( "UseAutosaveDirectory" ) = 1

            .cOption( "AutosaveDirectory" ) = ActiveWorkbook.Path & "\Export"

            .cOption( "AutosaveFilename" ) = Filename

            .cOption( "AutosaveFormat" ) = 0    ' 0 = PDF

            .cClearCache

         End With

         Selection.PrintOut Copies:= 1 , ActivePrinter:= "PDFCreator"

         AddStatus "Le fichier " & Filename & ".pdf a été exporté en PDF (" & I & "/" & UBound (B) & ")."

         Do Until PDFCreator1.cCountOfPrintjobs = 1

            DoEvents

            Sleep 2500

         Loop

         Sleep 2500

         ' PDFCreator1.cCombineAll ' Non utilisé dans ce cas

         PDFCreator1.cPrinterStop = False

         ' Permet de modifier le temps entre chaque feuille imprimée

         Sleep 2500

         DoEvents

         [A1].Select

         k = k + 1

         PctDone = k

         ' Appel de la procédure qui met à jour la ProgressBar

         UpdateProgressBarPDF PctDone

         DoEvents ' Permet au UserForm de se mettre à jour

         'Me.Repaint

      Next I

   End If

   If OptionButton2.Value = True Then

      Sheets( "Export PDF" ).Activate

      Filename = Application.Substitute(Sheets( "Export PDF" ).Cells( 1 , 1 ).Value, "/" , "_" , 1 )

      Range( "A1:AA29" ).Select

      Me.cmdAnnuler.Enabled = False

      With PDFCreator1

         .cOption( "UseAutosave" ) = 1

         .cOption( "UseAutosaveDirectory" ) = 1

         .cOption( "AutosaveDirectory" ) = ActiveWorkbook.Path & "\Export\"

         .cOption( "AutosaveFilename" ) = Filename

         .cOption( "AutosaveFormat" ) = 0    ' 0 = PDF

         .cClearCache

      End With

      Selection.PrintOut Copies:= 1 , ActivePrinter:= "PDFCreator"

      AddStatus "Le fichier " & Filename & ".pdf a été exporté en PDF."

      Do Until PDFCreator1.cCountOfPrintjobs = 1

         DoEvents

         Sleep 2500

      Loop

      Sleep 2500

      'PDFCreator1.cCombineAll ' Non utilisé dans ce cas

      PDFCreator1.cPrinterStop = False

      [A1].Select

   End If

   AddStatus "L'export est terminé."

End Sub

Private Sub cmdAnnuler_Click()

   PDFCreator1.cClose

   Set PDFCreator1 = Nothing

   Sleep 250

   DoEvents

   Sheets( "Export PDF" ).Activate

   [A1].Select

   Unload Me

End Sub

Private Sub cboAgences_Change()

   Sheets( "Export PDF" ).Cells( 1 , 1 ).Value = Me.cboAgences.Text

End Sub

Private Sub OptionButton1_Click()

   Me.cboAgences.Visible = False

End Sub

Private Sub OptionButton2_Click()

   Me.cboAgences.Visible = True

End Sub

Private Sub PDFCreator1_eError()

   AddStatus "ERROR [" & PDFCreator1.cErrorDetail( "Number" ) & "]: " & PDFCreator1.cErrorDetail(  

» "Description" )

End Sub

Private Sub PDFCreator1_eReady()

   'AddStatus "Le fichier'" & PDFCreator1.cOutputFilename & "' a été enregistré."

   PDFCreator1.cPrinterStop = True

   cmdExecute.Enabled = True

   Me.cmdAnnuler.Enabled = True

End Sub

Private Sub AddStatus(Str1 As String )

   Me.lstFiles.AddItem Now & ": " & Str1

   J = J + 1

   Me.lstFiles.Selected(J - 1 ) = True

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer , CloseMode As Integer )

   If CloseMode = vbFormControlMenu Then

      MsgBox "Cette option n'est pas autorisée." & vbCr & "Utiliser le bouton Fermer." , vbExclamation

      Cancel = True

   End If

End Sub

Sub UpdateProgressBarPDF(PctDone As Single )

   With frmPDFCreator

      ' Mise à jour du label

      .FrameProgress.Caption = "Avancement de " & Format (PctDone / nbLgn, "0%" )

      ' Afin de paramétrer la fin de la progressBar par rapport au frame

      .LabelProgress.Width = PctDone * 2 + (.FrameProgress.Width - 302 )

   End With

   ' DoEvents autorisant au UserForm de se mettre à jour

   DoEvents

End Sub

     Télécharger le fichier complet de cet exemple.

     Télécharger le fichier avec l'option Multi-Select.