Macro pour enregistrer un fichier pdf avec un nom différent

[Raan]

Bonjour, j'utilise cette macro pour enregistré un publipostage en version pdf mais le nom du document enregistré ne change pas ...

Comment puis-je faire pour que le nom enregistré corresponde à une des lignes de mon documents ?
Ou que le nom enregistré corresponde à un champ de fusion que j'aurai choisi ?

Sub Macro1()
'
' Macro1 Macro
'
'
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"C:\Users\istef\Desktop\pDF PUBLI\LM ATCA Sàrl.pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

 

[laurent3372]

Si le nom souhaité est dans la cellule B4 de la feuille active, il faut spécifier Range("B4").Value à la place du nom de fichier:

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Range("B4").Value, ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

 

[Raan]

alors c sur world pas sur excel ...

 

[Raan]

J'ai trouvé la solution si ça peut aider quelqu'un 🙂



Sub publipostage()
'imprime enregistrement par enregistrement
Dim fusion As MailMerge
Dim x As Integer, nb As Integer
Dim chemin As String, nom As String
Set fusion = ActiveDocument.MailMerge
chemin = "D:\Mes documents\" 'mettre ici le chemin complet du dossier où stocker les fichiers sans oublier le \ à la fin
nb = fusion.DataSource.RecordCount
For x = 0 To nb - 1
With fusion
.DataSource.FirstRecord = x + 1
.DataSource.LastRecord = x + 1
.Destination = wdSendToNewDocument
.DataSource.ActiveRecord = x + 1
nom = .DataSource.DataFields("Nom") 'Remplacer Nom" par le champ à utiliser
.Execute
End With
ActiveDocument.ExportAsFixedFormat OutputFileName:=chemin & nom & ".pdf", ExportFormat:=wdExportFormatPDF, openafterexport:=False
ActiveDocument.Close savechanges:=False

Next
End Sub

 

[kiki29]

Salut, à adapter à ton contexte, cela permet d'éviter les doublons en ajoutant un indice au nom du fichier ( voir pj ).

Option Explicit

Sub Test()
Dim sDossier As String, sNom As String

    sDossier = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    sNom = "test.pdf"

    CreationDossier sDossier
    sNom = RenommerFichier(sDossier, sNom)

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNom, _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
End Sub

Private Sub CreationDossier(sDossier As String)
Dim sChaine As String
    sChaine = Environ("comspec") & " /c mkdir " & sDossier
    Shell sChaine, 0
End Sub

Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Dir(sDossier & "\" & sNomfichier, vbNormal) <> vbNullString Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)

        i = 0
        While Dir(sDossier & "\" & sNouveauNom, vbNormal) <> vbNullString
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing

    RenommerFichier = sDossier & "\" & sNomfichier
End Function