Enregistrer un PDF en écrasant automatiquement la version la plus élevé

fred2705

XLDnaute Junior
Bonjour,

J’enregistre mes fichier dans un répertoire grâce à une macro qui incrémente comme ceci :

Contact__09.02.2015 V.pdf
Contact__15.02.2015 V2.pdf
Contact__15.02.2015 V3.pdf


J’aimerais une autre macro qui enregistre un PDF en écrasant automatiquement la version la plus élevé (V3) sachant que la date elle peut être différente.

Ci-dessous voici en essai une partie de mon code mais malheureusement il ne fonctionne pas !
Mes connaissances en VBA sont trop limitées ! Merci pour votre aide.


Code:
 Chemin = "O:\DEV & Q PRODUITS\PDF généré\"
    'Chemin = ThisWorkbook.Path & "\" 'plus facile pour tester
   
    date_test = Format([M1], "dd.mm.yyyy")
   
   If Dir(Chemin & [f1] & "__* V3.pdf") = "" Then
      NomFichier = [f1] & "__" & date_test & " V3.pdf"
   
         Else
            If Dir(Chemin & [f1] & "__* V2.pdf") = "" Then
            NomFichier = [f1] & "__" & date_test & " V2.pdf"
                 
         Else
                If Dir(Chemin & [f1] & "__* V3.pdf") = "" Then
                NomFichier = [f1] & "__" & date_test & " V.pdf"    
    End If
    End If
    End If
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
 

chris

XLDnaute Barbatruc
Re : Enregistrer un PDF en écrasant automatiquement la version la plus élevé

Bonjour

Si déjà tu numérotais tes version sur 2 caractères : V01, V02, etc il serait plus facile d'analyser les 2 derniers caractères du nom.

Un boucle Dir sur "Contact__*V??.pdf" permettrait de repérer la valeur la plus élevée à l'issue de la boucle.
 

fred2705

XLDnaute Junior
Re : Enregistrer un PDF en écrasant automatiquement la version la plus élevé

Merci mais que dois-je changer dans ma macro si dessous pour mettre 2 caractère (V01,V02...)?


Code:
Sub PdfCreator_connecteur()
Dim Chemin$, date_test$, NomFichier$, i&, JobPDF As Object

    'copier-coller pour comparer
    Range("O792").Select
    Selection.Copy
    Range("V796").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    'incrémenter la version de l'offre
    Range("N745") = Range("N745") + 1
      
    Chemin = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\2015\"
    'Chemin = ThisWorkbook.Path & "\" 'plus facile pour tester
   
    date_test = Format([M1], "dd.mm.yyyy")
   
    If Dir(Chemin & [P1] & "__" & [f1] & "__* V.pdf") = "" Then
      NomFichier = [P1] & "__" & [f1] & "__" & date_test & " V.pdf"
    Else
      i = 2
      While Dir(Chemin & [P1] & "__" & [f1] & "__* V" & i & ".pdf") <> ""
        i = i + 1
      Wend
      NomFichier = [P1] & "__" & [f1] & "__" & date_test & " V" & i & ".pdf"
    End If
 
    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
 

chris

XLDnaute Barbatruc
Re : Enregistrer un PDF en écrasant automatiquement la version la plus élevé

Bonjour

Pour nommer :
Code:
NomFichier = [P1] & "__" & [f1] & "__" & date_test & " V" & Format(i, "00") & ".pdf"
Pour la boucle :
Code:
Dim VersionPDF As String, Version0 As Integer, Version1 As Integer

    Version0 = 1
    VersionPDF = Dir(Chemin & [P1] & "__*V??.pdf")
    Do While VersionPDF <> ""
        Version1 = CInt(Left(Right(VersionPDF, 6), 2))
        If Version1 > Version0 Then Version0 = Version1
        VersionPDF = Dir
    Loop

A la fin de cette boucle, la valeur de Version0 donne le numéro de version le plus élevé, auquel tu peux ou non ajouter 1 selon ton choix, puis
Code:
NomFichier = [P1] & "__" & [f1] & "__" & date_test & " V" & Format(Version0, "00") & ".pdf"

Cela ne tient pas compte de l'existant avec tes versions V, V2, V3...
 

fred2705

XLDnaute Junior
Re : Enregistrer un PDF en écrasant automatiquement la version la plus élevé

Merci pour ta réponse, mais j'avoue que nage un peu là!

Pour résumer:

J'ai besoin de garder deux macro:

La première qui enregistre en V01, V02, V03 (c'est celle ci dessous mais actuellement elle enregistre en V, V2, V3 )

Code:
Sub PdfCreator_connecteur()
Dim Chemin$, date_test$, NomFichier$, i&, JobPDF As Object


    Chemin = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\2015\"
    'Chemin = ThisWorkbook.Path & "\" 'plus facile pour tester
   
    date_test = Format([M1], "dd.mm.yyyy")
   
    If Dir(Chemin & [P1] & "__" & [f1] & "__* V.pdf") = "" Then
      NomFichier = [P1] & "__" & [f1] & "__" & date_test & " V.pdf"
    Else
      i = 2
      While Dir(Chemin & [P1] & "__" & [f1] & "__* V" & i & ".pdf") <> ""
        i = i + 1
      Wend
      NomFichier = [P1] & "__" & [f1] & "__" & date_test & " V" & i & ".pdf"
    End If
 
    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

La seconde qui est identique à la première mais qui enregistre en écrasant la version la plus élevée


J'ai essayé mais je ne comprend pas vraiment ou je dois intégrer tes codes!
Désolé je ne suis pas un as du codage!!!
 

chris

XLDnaute Barbatruc
Re : Enregistrer un PDF en écrasant automatiquement la version la plus élevé

Re

Inutile d'avoir 2 versions il suffirait de préciser, ou dans une cellule, ou en passant un argument à la procédure, si c'est la version +1 ou la dernière.

Exemple par un choix en cellule Z1 cela devrait donner
Code:
Sub PdfCreator_connecteur()
Dim Chemin$, date_test$, NomFichier$, i&, JobPDF As Object
Dim VersionPDF As String, Version0 As Integer, Version1 As Integer

    Chemin = "O:\DEV & Q PRODUITS\1 - DEVELOPPEMENT PRODUITS\Calculations prix\PDF généré\2015\"
    'Chemin = ThisWorkbook.Path & "\" 'plus facile pour tester
   
    date_test = Format([M1], "dd.mm.yyyy")
   
    Version0 = 1
    VersionPDF = Dir(Chemin & [P1] & "__*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 = [P1] & "__" & [f1] & "__" & 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
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 196
Messages
2 086 101
Membres
103 116
dernier inscrit
kutobi87