Enregistrement d'un PDF avec incrémentation du nom

Bonjour,

Je n'arrive pas à m'en sortir pour la création d'une simple MACRO pour créer et enregistrer le PDF dans un dossier tout en changeant le nom

(incrémention ou changement de nom)

Merci pour votre aide

Bonjour

Je pense que ce problème a déjà été résolu plusieurs fois dans le forum, lance une recherche avec enregistrer en pdf

Bonjour,

Je t'invite à jeter un œil à ce code :

Sub Enreg_Pdf()
Dim LeNom As String, LeRep As String
LeNom = Range("D6").Value 'Nom du dossier se trouvant dans la cellule de ton choix
LeRep = ThisWorkbook.Path & "\NomdeDossier\"  ' à adapter ! De cette manière le pdf sera enregistré dans un dossier nomé NomdeDossier se situant au même niveau que le fichier exel
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    LeRep & LeNom & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
End Sub

'Tu peux modifier ou ajouter des paramêtres si tu le souhaite

Bonjour,

Le code pour sauvegarder tu peux facilement l'obtenir via l'enregistreur de macro, ce qui va plus te poser soucis c'est d'incrémenter le nom de ton fichier sachant que tu ne sais pas les noms des autres fichiers, si tu as un dossier qui ne gères que tes PDF enregistrés via macro, le plus simple sera de donner une partie de nom fixe: "exemple n" , et une partie de nom variable, l'astuce ce serait d'avoir la propriété count de ton dossier (objet folder) et de le mettre à la suite de ton nom, tu aurais ainsi exemple n0, exemple n1 et ainsi de suite...

Public Sub Test()
    Dim fso As Scripting.FileSystemObject
    Dim fld As Scripting.Folder

    Set fso = New Scripting.FileSystemObject
    Set fld = fso.GetFolder("TonChemin")
    MsgBox fld.Files.Count

End Sub
Public Sub Test()
    Dim fso As Scripting.FileSystemObject
    Dim fld As Scripting.Folder
    Dim fil As Scripting.File
    Dim i As Long

 i = 0
    Set fso = New Scripting.FileSystemObject
    Set fld = fso.GetFolder("TonRépertoire")
    For Each fil In fld.Files
        If fil.Name like "*.pdf" Then
            i = i + 1
        End If
    Next fil

    MsgBox i
end sub
On pourrait aussi faire ça avec le nom standard qu'on donne :
Public Sub Test()
    Dim fso As Scripting.FileSystemObject
    Dim fld As Scripting.Folder
    Dim fil As Scripting.File
    Dim i As Long

i = 0
    Set fso = New Scripting.FileSystemObject
    Set fld = fso.GetFolder("TonRépertoire")
    For Each fil In fld.Files
        If fil.name like "exemple n*.pdf" Then
            i = i + 1
        End If
    Next fil

    MsgBox i
end sub

Ensuite tu n'as plus qu'à mettre ça dans ton nom :

msgbox("exemple n" & fld.files.count)

ou

msgbox("exemple n" & i)

Bonjour à tous,

Ci-dessous mon code pour la macro d'enregistrement en .PDF et incrémentation du nom.

Le fichier 'senregistre à chaque sous un nouveau en écrasant l'ancien.

je voudrais préserver l'ancien en incrémentant le nom du fichier

EX : Sui_001, Suivi_002, etc...

Sub EnregPDF()
'
    Dim ws As Worksheet, Chemin$, Fichier$, nF$, n%
    Chemin = "C:\Users\clima\Desktop\Nouveau SUIVI\PDF\"
    For Each ws In ActiveWorkbook.Worksheets
        Fichier = ws.Range("G10") & "*" & ".pdf"
        nF = Dir(Chemin & Fichier): n = 0
        Do While nF <> ""
            n = n + 1
            nF = Dir()
        Loop
        If n > 0 Then ws.Range("G10") = ws.Range("G10") & "_" & n
    Next ws
    For Each ws In ActiveWorkbook.Worksheets
        Fichier = ws.Range("G10") & ".pdf"
      ws.ExportAsFixedFormat xlTypePDF, Chemin & Fichier
    Next ws
End Sub

Bonjour,

Suite à mon dernier message ci-dessous, quelqu'un pourrait me conseiller sur le codage à appliquer pour que cela fonctionne...

merci d'avance

Bonjour,

Comme je t'ai dis dans mon précédent message, tu peux compter le nombre de pdf qui commencent avec un nom standard :

Public Sub Test()
    Dim fso As Scripting.FileSystemObject
    Dim fld As Scripting.Folder
    Dim fil As Scripting.File
    Dim i As Long

i = 0
    Set fso = New Scripting.FileSystemObject
    Set fld = fso.GetFolder("TonRépertoire")
    For Each fil In fld.Files
        If fil.name like "exemple n*.pdf" Then
            i = i + 1
        End If
    Next fil

    MsgBox i
end sub

Tu renommes i par nb_pdf par exemple, et tu lances ce code avant ton code pour enregistrer les feuilles, tu incrémentes simplement nb_fichiers à chaque enregistrement et le reste suivra, ton code donnerait :

 Sub EnregPDF()
 '
    Dim fso As Scripting.FileSystemObject
    Dim fld As Scripting.Folder
    Dim fil As Scripting.File
    Dim nb_fichiers As Long
    Dim ws As Worksheet, Chemin$, Fichier$, nF$, n%
    Chemin = "C:\Users\clima\Desktop\Nouveau SUIVI\PDF\"
    nb_fichiers = 0
    Set fso = New Scripting.FileSystemObject
    Set fld = fso.GetFolder(Chemin)
    For Each fil In fld.Files
        If fil.name like "*.pdf" Then
            nb_fichiers = nb_fichiers + 1
        End If
    Next fil

 For Each ws In ActiveWorkbook.Worksheets
     Fichier = ws.Range("G10") & "*" & ".pdf"
     nF = Dir(Chemin & Fichier): n = 0
     Do While nF <> ""
         n = n + 1
         nF = Dir()
     Loop
     If n > 0 Then ws.Range("G10") = ws.Range("G10") & "_" & n
 Next ws
 For Each ws In ActiveWorkbook.Worksheets
     nb_fichiers = nb_fichiers + 1
     Fichier = ws.Range("G10") & "_" & nb_fichiers & ".pdf"
     ws.ExportAsFixedFormat xlTypePDF, Chemin & Fichier
 Next ws
 End Sub

Essaye ce code

Erreur

erreur

bonjour à tous

les pieds dans le plat : à quoi ça sert ?

pourquoi enregistrer des pdf successifs ?

Charly,

à te relire

bonjour à tous

les pieds dans le plat : à quoi ça sert ?

pourquoi enregistrer des pdf successifs ?

Charly,

à te relire

Bonjour jmd,

Bonne question en effet,

Charly65, une réponse aussi courte que la tienne:

Dans VBA Outils | Références : Cocher Microsoft Scripting Runtime

Sinon ça ne marchera pas

Rechercher des sujets similaires à "enregistrement pdf incrementation nom"