insérer nom du fichier en bas de page dans un fichier PDF en VBA

bonjour,
j'aurais une centaine de fichiers .pdf à imprimer seulement avant de les imprimer j'aimerais y insérer en bas de page du pdf le nom du fichier avec le VBA de Excel,
Sinon je ne saurais jamais à quel fichier correspond la version papier si vous voyez ce que je veux faire.
bb
AM

Salut, voir ici : PDFCreator Numérotation des Pages, En-Tête et Pied de page, en l'adaptant à ton contexte.

PDFCreator et VBA Excel

bonjour,
j'avais déjà le PDFCreator d'installé sur le PC, ton exemple marche super bien comme une horloge, encore merci.
bb
AM

1 pièce(s) jointe(s)

Salut, une solution plus complète

Affecter un bouton à la procédure SelFichier
Un dossier baptisé "PDFs_PDP" sera créé à la racine de l'appli.
Les fichiers modifiés y seront sauvegardés avec le suffixe "_copie"
A toi d'élaguer/modifier/adapter à ton contexte.

Code à insérer dans un module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
 
Private Dep As Currency, Fin As Currency, Freq As Currency
 
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long
Dim iNbPages As Long
 
Private Function CreationDossier(sDossier) As Long
    SHCreateDirectoryEx 0&, sDossier, 0&
End Function
 
Sub SelFichier()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
 
    Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    If Fichier <> False Then
        Application.StatusBar = ""
        QueryPerformanceCounter Dep
        NumPiedDe_Pages (Fichier)
        QueryPerformanceCounter Fin
        QueryPerformanceFrequency Freq
        Application.StatusBar = "Terminé : " & Format(((Fin - Dep) / Freq), "0.000 s")
    End If
End Sub
 
Private Function NbPages(ByVal sFichier As String) As Long
Dim Pdf As Object
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    NbPages = Pdf.NumberOfPages(sFichier)
    Set Pdf = Nothing
End Function
 
Private Sub NumPiedDe_Pages(sFichier As String)
Dim Pdf As Object, pdfNumPages As Object, WshShell As Object, pdfNomFichier As Object
Dim sDossier As String, sNom As String, FSO As Object
 
    sDossier = ThisWorkbook.Path & "\" & "PDFs_PDP"
    CreationDossier sDossier
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sNom = FSO.GetBaseName(sFichier) & "_copie.pdf"
    Set FSO = Nothing
 
    Set WshShell = CreateObject("WScript.Shell")
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    iNbPages = NbPages(sFichier)
 
    Set pdfNumPages = CreateObject("pdfforge.pdf.pdfText")
    With pdfNumPages
        .Text = "[PAGE] / [PAGES]"
        .FontColorRed = 0
        .FontColorGreen = 0
        .FontColorBlue = 0
        .FontName = "comicbd.TTF"
        .FontPath = WshShell.SpecialFolders("Fonts")
        .FontSize = 12
    End With
 
    Set pdfNomFichier = CreateObject("pdfforge.pdf.pdfText")
    With pdfNomFichier
        .Text = sNom
        .FontColorRed = 0
        .FontColorGreen = 0
        .FontColorBlue = 0
        .FontName = "timesbd.ttf"
        .FontPath = WshShell.SpecialFolders("Fonts")
        .FontSize = 12
    End With
 
    'Public Function AddPageNumberToPDFFile( _
     '    sourceFilename As String, _
     '    destinationFilename As String, _
     '    fromPage As Integer, _
     '    toPage As Integer, _
     '    startPageNumber As Integer, _
     '    NumberOfPages As Integer, _
     '    pageNumberPosition As Integer, _
     '    borderXMillimeter As Single, _
     '    borderYMillimeter As Single, _
     '    ByRef textObject As pdfText _
     ') As Integer
 
    'Page number position
    '1: Top Left
    '2: Top middle
    '3: Top Right
    '4: bottom Left
    '5: bottom middle
    '6: bottom Right
 
    Pdf.AddPageNumberToPDFFile sFichier, sDossier & "\" & "Tempo.pdf", 1, iNbPages, 1, iNbPages, 6, 5, 5, pdfNumPages
    Pdf.AddPageNumberToPDFFile sDossier & "\" & "Tempo.pdf", sDossier & "\" & sNom, 1, iNbPages, 1, iNbPages, 4, 5, 5, pdfNomFichier
 
    Kill sDossier & "\" & "Tempo.pdf"
 
    Set pdfNomFichier = Nothing
    Set pdfNumPages = Nothing
    Set Pdf = Nothing
    Set WshShell = Nothing
End Sub

PDFCreator et VBA Excel

bonjour,
je vais essayer ça, par contre sur un autre PC avec le PDFCreator version V2.5.2 ça donne une erreur sur Set pdf = CreateObject("pdfforge.pdf.pdf")
bb
am

Salut, il te faut PDFCreator 1.7.3 pas les 2.x, 3.x et autres car l'appli a totalement été réécrite, les méthodes/propriétés ne sont pas facilement/plus accessibles ( versions payantes obligent )

1 pièce(s) jointe(s)

Re, la version finale ?