PDFCreator et VBA

[mécano41]

Bonjour à tous,

Pour éditer des fiches, j'ai utilisé la méthode suivante :

- dans une feuille, une fiche "modèle" recto + verso est composée de champs avec formules
- les deux zones constituent la zone d'impression
- un cellule (hors zone) reçoit la position de la ligne de la base de données où les formules doivent prendre les éléments pour constituer la fiche ; elle est modifiée par VBA
- le code ci-après (vu sur plusieurs fils ici-même) me permet de créer un fichier .pdf pour chaque fiche

(ce code parce que, si je suis en EXCEL 2010, l'utilisateur est en EXCEL 2003)

Question : si je souhaite envoyer plusieurs fiches (voir les 400) dans le même .pdf, que faut-il ajouter à ce code? (je n'envisage pas de dupliquer le recto-verso en 400 exemplaires)

Private Sub CommandButton1_Click()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String

' ---- Indique le nom du fichier et le chemin du répertoire
sNomPDF = "Essai_" & ".pdf"
sCheminPDF = ThisWorkbook.Path & "\"
' ----- Vérifie si données dans la feuille
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
' ----- Transmet les paramètre à PDFCreator
Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
With JobPDF
    If .cStart("/NoProcessingAtStartup") = False Then
        MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
        Exit Sub
    End If
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1
    .cOption("AutosaveDirectory") = sCheminPDF
    .cOption("AutosaveFilename") = sNomPDF
    .cOption("AutosaveFormat") = 0                     ' Type de fichier : 0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
    .cClearCache
End With
' ---- Indique le nombres de copies et l'imprimante virtuelle - Impression
ActiveWorkbook.PrintOut copies:=1, ActivePrinter:="PDFCreator"
' ----- Fichier dans la file d'attente
Do Until JobPDF.cCountOfPrintjobs = 1
    DoEvents
Loop
JobPDF.cPrinterStop = False
' ----- Attendre que la file d'attente soit vide
Do Until JobPDF.cCountOfPrintjobs = 0
    DoEvents
Loop
Application.Wait Now + TimeValue("00:00:03")
JobPDF.cClose
Set JobPDF = Nothing
End Sub

Merci d'avance,

Cordialement

 

[mécano41]

Re : PDFCreator et VBA

Bonjour,

Je ne cherchais pas à tester tes capacités en matière d'utilisation du Tarot de Marseille ou du marc de café mais à profiter, si possible, (ici :fleurs encore fermées) de tes compétences reconnues (ici : fleurs ouvertes) dans l'utilisation de PDFCreator pour le cas qui m'intéresse aujourd'hui ...

J'ai trouvé d'où provenait ce problème : une erreur quelconque interdisait de finir le code et donc de fermer l'instance PDFCreator, d'où maintenant le "on error goto Fin"... mais je ne comprends toujours pas pourquoi la non-fermeture produit un défaut tel qu'il faille redémarrer l'ordi...enfin, tant pis ... c'est résolu.

J'ai une autre demande : le code joint me permet d'imprimer successivement plusieurs fichiers indépendants en PDF.

Actuellement, sur ma machine : temps = 2,4 secondes par fiche

J'en ai 400 ; ce n'est pas dramatique mais ... y-a-t-il quelque chose à modifier pour réduire un peu ce temps?

Merci d'avance.

Cordialement

Sub CreeMultiPDF(Position)  ' Position = N° d'ordre de la fiche à traiter si c'est 0, on imprime toutes les fiches
ici:
 - déclare les variables
 - vérifie l'existence de PDFCreator
 - rend visible la feuille à imprimer
 - définit la zone d'impression
 - mémorise le nom de l'imprimante active
 - définit les noms de répertoires, fichiers....
    Racine = ....
    SsRep = ....
    NmFic = .... nom générique de la forme "xxx MATRICULE xxxxx"
    N°MatFiche= .... N° matricule de la fiche
On Error GoTo Fin
Set InstancePDF = CreateObject("PDFCreator.clsPDFCreator")
With InstancePDF
    If .cStart("/NoProcessingAtStartup") = False Then           ' Détecte un éventuel défaut
        MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
        Set InstancePDF = Nothing
        Exit Sub
    End If
End With
If Position <> 0 Then  ' Cas d'une seule fiche
    Fiche = Position
    NmFic = Replace(NmFic, "Matricule", N°MatFiche) & ".pdf"   ' Remplace "MATRICULE" par le N°
    Call SortieUnitairePdfCreator(F7, InstancePDF, NmFic, Racine & "\" & SsRep & "\")
Else    ' Cas de toutes les fiches
    With F7
        For Fiche = 1 To ...position dernière fiche à imprimer
            Mise à jour fiche-modèle (= 1 rect + 1 verso. MàJ formules sur ordre)
            NmFic1 = Replace(NmFic, "Matricule", N°MatFiche) & ".pdf"  ' Remplace "MATRICULE" par le N°
            Call SortieUnitairePdfCreator(F7, InstancePDF, NmFic1, Racine & "\" & SsRep & "\")
        Next Fiche
    End With
End If
Fin:  ' Sortie normale ET traitement erreur
InstancePDF.cClose
Set InstancePDF = Nothing
With F7
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    .Visible = xlSheetHidden
End With
Application.ActivePrinter = MemPrint    ' Remet l'imprimante active initiale
End Sub

' ---------------
Sub SortieUnitairePdfCreator(FeuilAimpr As Worksheet, JobPDF As Object, sNomPDF As String, sNomChem As String)
With JobPDF
    .cPrinterStop = True
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1
    .cOption("AutosaveDirectory") = sNomChem
    .cOption("AutosaveFormat") = 0
    .cOption("AutosaveFilename") = sNomPDF
    .cClearCache
    FeuilAimpr.PrintOut From:=1, To:=2, Copies:=1, ActivePrinter:="PDFCreator"
        Do Until .cCountOfPrintjobs = 1
            DoEvents
        Loop
        .cPrinterStop = False
        Do Until .cCountOfPrintjobs = 0
            DoEvents
        Loop
End With
End Sub