Création PDf depuis EXCEL 2002 et PDFcreator

[GillesC]

Bonjour à tous,
j'avais cru trouver mon bonheur avec un code qui me faisait bien des PDF :

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDFCreator sur Ne00:", printtofile:=True, Collate:=True, prtofilename:="lenomdufichier.pdf"

seulement...message d'erreur lors de l'ouverture de ces PDF. Ils ont la couleur du PDF, l'odeur du PDF, mais ce ne sont pas des PDF !!

J'ai donc EXCEL 2002, et PDFcreator.

Y a-t-il quelqu'un qui a réussi a trouver un ligne de code simple pour enregistrer un onglet "Test" en fichier "Test.pdf" et qui soit un vrai PDF? Et avec Excel 2002 et PDFcreator, car tout ce que je trouve concerne d'autres versions.


J'ai essayé des dizaines de liens trouvés sur ce forum ou ailleurs, à chaque fois je me retrouve avec des messages d'erreur pour les codes que je teste.

Merci d'avance

 

[gilbert_RGI]

Re : Création PDf depuis EXCEL 2002 et PDFcreator

Bonjour

à tester et à ajuster suivant la demande

Sub ImprPdf()
 Dim pdfjob As Object, myprint As String, Port As Integer, Q As String, NoMFichier As String, fichname As String
 Dim Destin As String, txt As String, NomPdf As String, DefaultPrinter As String
 Q = ""
 For Port = 0 To 9 ' test tous les ports imprimantes pour activer pdfCreator en imprimante active
         
        myprint = "PDFCreator sur Ne0" & Port & ":"
         On Error Resume Next
         ActivePrinter = myprint
         If ActivePrinter = myprint Then
             
            Exit For
         End If
     Next
  Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
     With pdfjob
         If .cstart("/NoProcessingAtStartup") = False Then ' démarre Pdf Creator en cas de probleme il te le dit
             MsgBox " PDFCreator n'a pu être démarrer.", vbCritical + vbOKOnly, "PrtPDFCreator"
             Exit Sub
         End If
     End With
 

    NoMFichier = "Récapitulatif Ibis Tarbes " & mois & " " & année ' détermine le non de ton fichier
     fichname = ThisWorkbook.Path & "\" & NoMFichier & ".pdf" ' tu choisis où tu veux que ton fichier soit enregistrer
     Destin = fichname
     txt = Dir(Destin, vbNormal) ' test te permettant de savoir si un fichier du m^me nom existe déja
     If txt <> "" Then
         MsgBox "Ce récapitulatif existe déja"
         Exit Sub
     End If
     
       
             
            NomPdf = NoMFichier & ".pdf"
             
            
                With pdfjob ' application de la configuration demandé plus haut ( nom et chemin du fichier)
                     .cOption("UseAutosave") = 1
                     .cOption("UseAutisaveDirectory") = 1
                     .cOption("AutosaveDirectory") = (ThisWorkbook.Path)
                     .cOption("AutosaveFilename") = NomPdf
                     .cOption("AutosaveFormat") = 0
                     .cClearCache
                     DefaultPrinter = .cDefaultprinter
                 End With
             
           
             ThisWorkbook.Worksheets("feuil1").PrintOut Copies:=1, ActivePrinter:=Q & myprint & Q
            
             
                Do Until pdfjob.cCountOfPrintjobs = 1
                     DoEvents
                 Loop
                 pdfjob.cPrinterStop = False
                 Do Until pdfjob.cCountOfPrintjobs = 0
                     DoEvents
                 Loop
                 'Call Sleep(750)
                 With pdfjob
                     .cDefaultprinter = DefaultPrinter
                     .cClearCache
                 End With
                 Set pdfjob = Nothing
                 MsgBox ("Le nom de votre fichier : " & NomPdf)
                 MsgBox (" Le chemin de ce fichier est : " & ThisWorkbook.Path)
 End Sub