Enregistrement PDF avec vérification

Bonjour à tous,

J'ai crée une macro d'enregistrement automatique de mon fichier en pdf dans un chemin défini. Cette macro fonctionne seulement j'aimerais ajouter une fonction que je ne trouve pas dans votre forum ou bien sur internet.

Il s'agirait d'ajouter un index à mon fichier enregistré si ce fichier existe déjà dans le répertoire de destination.

Je sais qu'il faut passer par une boucle afin d'incrémenter mais cela dépasse mon niveau.

Sub Save()
Dim ws As Worksheet
Dim Chemin As String, Fichier As String

    Chemin = "J:\12 - UTILISATEURS"
    For Each ws In ActiveWorkbook.Worksheets
        Fichier = ws.Range("C14").Value
        ws.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=Chemin & Fichier, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
    Next

 If ExistePdf(Fichier) Then

 'incrémentation via boucle ? ?

        MsgBox "Cle fichier a été indexé"
    Else
    Chemin = "J:\12 - UTILISATEURS"
    For Each ws In ActiveWorkbook.Worksheets
        Fichier = ws.Range("C14").Value
        ws.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=Chemin & Fichier, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
    Next
    End If
End Sub

De plus si vous avez la propriété qui permet d'enregistrer le PDF en format paysage et non portrait, je suis preneur

Merci d'avance pour votre aide.

Bonsoir,

Il serait bon que tu précises le contenu de C14...

et que tu indiques la forme de l'index (qui sera absent du premier fichier ?) ?

Le format paysage tu le définis par les paramètres d'impression.

Bonjour,

Pardon pour ce manque d'information.

Le contenu de C14 est un numéro d'affaire (exemple : 17129_001).

J'aimerais enregistrer de cette manière :

nom du fichier : Facturation_17129_001.pdf

Si le fichier existe déjà alors :

nom du fichier : Facturation_17129_001_1.pdf

Si le fichier existe déjà alors :

nom du fichier : Facturation_17129_001_2.pdf

Est ainsi de suite.

Essayer :

Sub EnregPDF()
    Dim ws As Worksheet, Chemin$, Fichier$, nF$, n%
    Chemin = "J:\12 - UTILISATEURS\"
    For Each ws In ActiveWorkbook.Worksheets
        Fichier = ws.Range("C14") & "*" & ".pdf"
        nF = Dir(Chemin & Fichier): n = 0
        Do While nF <> ""
            n = n + 1
            nF = Dir()
        Loop
        If n > 0 Then ws.Range("C14") = ws.Range("C14") & "_" & n
    Next ws
    For Each ws In ActiveWorkbook.Worksheets
        Fichier = ws.Range("C14") & ".pdf"
        ws.ExportAsFixedFormat xlTypePDF, Chemin & Fichier
    Next ws
End Sub

NB- Pas le temps de monter un dispositif pour tester...

Cordialement.

Bonjour,

Merci pour votre réponse. J'essaie de comprendre votre fonction. Analyse t-elle le contenu de mon dossier destination afin de vérifier l’existence d'un fichier identique ou bien elle s'incrémente au nombre de clic fait durant l'ouverture du fichier ?

Imaginons que je ferme le fichier pour l'ouvrir quelques jours après, l'incrémentation fonctionnera-t-elle aussi ?

Merci d'avance

Si tu l'essayais d'abord, pour voir si elle incrémente bien les noms en fonction des fichiers présents dans ton dossier... !

J'ai essayé

Seulement ce qui ne va pas c'est que cela modifie mon numéro d'affaire dans la cellule excel C14 également.

Il faut que la valeur de la cellule C14 ne s'incrémente pas car il s'agit d'un numéro d'affaire fixe à mon administration.

Ça c'est secondaire... ! Il faut d'abord s'assurer que l'incrémentation fonctionne comme prévu...

Pour ne pas toucher à tes numéros d'affaires, on va mettre feuilles et contenus (incrémentés) des cellules dans un tableau qui servira à finaliser l'opération.

Et voilà :

Sub EnregPDF()
    Dim Pdf(), Chemin$, Fichier$, nF$, n%, i%
    Chemin = "J:\12 - UTILISATEURS\"
    ReDim Pdf(1 To ActiveWorkbook.Worksheets.Count)
    For i = 1 To ActiveWorkbook.Worksheets.Count
        With ActiveWorkbook.Worksheets(i)
            Fichier = .Range("C14") & "*" & ".pdf"
            nF = Dir(Chemin & Fichier): n = 0
            Do While nF <> ""
                n = n + 1
                nF = Dir()
            Loop
            Pdf(i) = .Range("C14")
            If n > 0 Then Pdf(i) = Pdf(i) & "_" & n
        End With
    Next i
    For i = 1 To UBound(Pdf)
        Fichier = Pdf(i) & ".pdf"
        ActiveWorkbook.Worksheets(i).ExportAsFixedFormat xlTypePDF, Chemin & Fichier
    Next i
End Sub