Impression PDF incrémenté

[fred2705]

Bonjour a tous,

Je vous expliques, j'ai un bouton avec un code qui me créer des PDF et l'enregistre sous un nom et répertoire défini automatiquement, de plus il y à une incrémentation automatique, V1,V2,V3....

Bref ce code marche très bien sur excel 2003, mais maintenant que je suis passé sur 2010 plus moyen de le faire tourner!!!

Pour info je ne suis pas calé en code VBA...et évidemment là je suis dépassé, donc si qq peut m'aider ca serait sympa?

Merci et voici le fameux code:

Sub PdfCreator_contact()
Dim Chemin$, date_test$, NomFichier$, i&, JobPDF As Object
Dim VersionPDF As String, Version0 As Integer, Version1 As Integer
        
        
        
        'Chemin = ThisWorkbook.Path & "\" ' pour tester
    Chemin = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\"
 
   
    date_test = Format([N1], "dd.mm.yyyy")
   
    Version0 = 0
    VersionPDF = Dir(Chemin & [Q1] & "__" & [E1] & "__*V??.pdf")
    Do While VersionPDF <> ""
        Version1 = CInt(Left(Right(VersionPDF, 6), 2))
        If Version1 > Version0 Then Version0 = Version1
        VersionPDF = Dir
    Loop
    
    'incrémenter ou non la version de l'offre
    '******
    'Prévoir une cellule, par exemple Z1 qui contiendra 1 ou 0 si on veut ou non augmenter d'une version
    Version0 = Version0 + Range("Z1").Value
    NomFichier = [Q1] & "__" & [E1] & "__" & date_test & " V" & Format(Version0, "00") & ".pdf"
    
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")

    With JobPDF
        .cStart "/NoProcessingAtStartup"
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = Chemin
        .cOption("AutosaveFilename") = NomFichier
        .cOption("AutosaveStartStandardProgram") = 1
        .cOption("UpdateInterval") = 0
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With
   
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    JobPDF.cPrinterStop = False

    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop

    JobPDF.cClose
    Set JobPDF = Nothing
    

End Sub

 

[kiki29]

Re : Impression PDF incrémenté

Salut, depuis Office 2007 SP2 le format pdf est inclus en natif dans Office, et le besoin d'utiliser PDFCreator n'existe plus, sauf si l'on veut manipuler les fichiers pdf.

 

[fred2705]

Re : Impression PDF incrémenté

Salut et merci pour ta réponse,

Mais qu'entend tu par natif?

et comme je leurs donnes un nom défini selon des cellules et une incrémentation 1,2,3,4,5... cela me semble spécifique non?

Encore merci.

 

[kiki29]

Re : Impression PDF incrémenté

Salut, enrichis ton vocabulaire ... voir ici

pour l'incrémentation, utilises qqch comme ceci

Private Function RenommerFichierPDF(sChemin As String, sNomFichier As String) As String
Dim sNouveauNom As String
Dim i As Long
Dim FSO As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.fileExists(sChemin & "\" & sNomFichier & ".pdf") = True Then
        sNouveauNom = sNomFichier
        i = 0
        While FSO.fileExists(sChemin & "\" & sNouveauNom & ".pdf") = True
            i = i + 1
            sNouveauNom = sNomFichier & Chr(40) & Format(i, "000") & Chr(41)
        Wend
        sNomFichier = sNouveauNom
    End If
    Set FSO = Nothing
    RenommerFichierPDF = sNomFichier
End Function

 

[fred2705]

Re : Impression PDF incrémenté

Merci mais dans mon cas j'ai besoin de passer par deux boutons macro par lesquels ont choisi le type d'enregistrement

Pour être plus clair voici en fichier joint une image explicative du choix des deux boutons macro


Et voici mon code complet qui permet en fonction du choix Sub PDF_choix_contact_0() ou Sub PDF_choix_contact_1() de lancer l'enregistrement en PDF

Sub PDF_choix_contact_0()


'stoper si n°P pas remplie
If Range("AA1") = "0" Then
MsgBox ("Vous devez d'abord introduire un numéro P")
Exit Sub
Else
End If

'0 pour écraser la version actuelle
Range("Z1") = "0"

Dim ret As Integer
ret = MsgBox("Vous allez écraser la version actuelle?", vbYesNo + vbExclamation)
If ret = vbNo Then
Exit Sub
Else
End If
Call PdfCreator_contact

End Sub






Sub PDF_choix_contact_1()


'stoper si n°P pas remplie
If Range("AA1") = "0" Then
MsgBox ("Vous devez d'abord introduire un numéro P")
Exit Sub
Else
End If

'1 pour nouvelle version
Range("Z1") = "1"


Dim ret As Integer
ret = MsgBox("Vous allez créer un nouvelle version?", vbYesNo + vbExclamation)
If ret = vbNo Then
Exit Sub
Else
End If


Call PdfCreator_contact

End Sub







Sub PdfCreator_contact()

Dim Chemin$, date_test$, NomFichier$, i&, JobPDF As Object
Dim VersionPDF As String, Version0 As Integer, Version1 As Integer

        
        
        'Chemin = ThisWorkbook.Path & "\" ' pour tester
    Chemin = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\"
 
   
    date_test = Format([N1], "dd.mm.yyyy")
   
    Version0 = 0
    VersionPDF = Dir(Chemin & [Q1] & "__" & [E1] & "__*V??.pdf")
    Do While VersionPDF <> ""
        Version1 = CInt(Left(Right(VersionPDF, 6), 2))
        If Version1 > Version0 Then Version0 = Version1
        VersionPDF = Dir
    Loop
    
    'incrémenter ou non la version de l'offre
    '******
    'Prévoir une cellule, par exemple Z1 qui contiendra 1 ou 0 si on veut ou non augmenter d'une version
    Version0 = Version0 + Range("Z1").Value
    NomFichier = [Q1] & "__" & [E1] & "__" & date_test & " V" & Format(Version0, "00") & ".pdf"
    
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")

    With JobPDF
        .cStart "/NoProcessingAtStartup"
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = Chemin
        .cOption("AutosaveFilename") = NomFichier
        .cOption("AutosaveStartStandardProgram") = 1
        .cOption("UpdateInterval") = 0
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With
   
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    JobPDF.cPrinterStop = False

    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop

    JobPDF.cClose
    Set JobPDF = Nothing
    

End Sub

Merci infiniment pour votre aide.

 

[kiki29]

Re : Impression PDF incrémenté

Salut, un exemple à adapter à ton contexte : ici

 

[fred2705]

Re : Impression PDF incrémenté

Afin d'être plus clair voici un exemple de mon fichier simplifié (en format .xls) que j'utilise avec excel 2003 mais qui ne fonctionne plus en version 2010

Merci pour votre coup de pouce qui me serait très précieux.