Discussion :

[timtim0]

Bonjour,

Je souhaite réaliser un sommaire pour un dossier composé de plusieurs PDF.
Je souhaite donc utiliser une macro qui m'affiche le nombre de page de chaque PDF.

Exemple :

Fichier	Nombre de pages
a.pdf	2
b.pdf	1
c.pdf	4

Quand je teste mon code avec deux fichiers importer simplement il fonctionne, mais dès lors que je l'exécute sur un tableau croisé dynamique créé à l'aide d'une base de données importée, il y a l'erreur : "Nom de fichier ou numéro incorrect (Erreur 52)" (sur la ligne 7).
Quelqu'un a t-il déjà eu un problème de ce genre? Ou sait où pourrais se trouver mon erreur?

Les liens sont dans la colonne D et je souhaite avoir le nombre de pages dans la colonne E

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Explicit
 
Sub pagination()
Dim MyPath As String, MyFile As String
Dim i As Long
MyPath = "\\192.168.1.5\commun\...\dossier"
MyFile = Dir(MyPath & Application.PathSeparator & "*.pdf", vbDirectory)
Range("E").ClearContents
Range("D3") = "File Name": Range("E3") = "Pages"
Range("D3:E3").Font.Bold = True
i = 3
Do While MyFile <> ""
i = i + 1
Range("D" & i) = MyFile
Range("E" & i) = GetPageNum(MyPath & Application.PathSeparator & MyFile)
MyFile = Dir
Loop
Columns("D:E").AutoFit
MsgBox "Total of " & i - 1 & " PDF files have been found" & vbCrLf _
& " File names and corresponding count of pages have been written on " _
& ActiveSheet.Name, vbInformation, "Report..."
End Sub
 
Function GetPageNum(PDF_File As String)
'Haluk 19/10/2008
Dim FileNum As Long
Dim strRetVal As String
Dim RegExp
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
FileNum = FreeFile
Open PDF_File For Binary As #FileNum
strRetVal = Space(LOF(FileNum))
Get #FileNum, , strRetVal
Close #FileNum
GetPageNum = RegExp.Execute(strRetVal).Count
End Function

[kiki29]

Salut, suivant les outils dont tu disposes :

• RegExp : Nombre de pages d'une liste de fichiers PDF
• Acrobat ( pas le Reader ) : Nombre de pages d'une liste de fichiers pdf
• PDFCreator 1.7.3 : Nombre de pages d'une liste de fichiers PDF

RegExp ne retournant pas toujours le nombre correct de pages voire rien du tout, par rapport à Acrobat ou PDFCreator. Voir par exemple ici

[kiki29]

Une autre voie à explorer serait via Pdfinfo d'Xpdf avec les contraintes de chemins/noms de fichiers sans espaces.

[kiki29]

Après qqs tribulations on peut aboutir à qqch comme ceci avec Pdfinfo.

[timtim0]

C'est bon, j'ai résolu à l'aide du code de PDF Creator du lien du post #2 que j'ai réadapté à mon problème, ce qui donne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Option Explicit
 
Sub pagination()
Dim MyFile As String
Dim i As Long
Range("D3") = "File Name": Range("E3") = "Nombre de Pages"
Range("D3:E3").Font.Bold = True
 
For i = 4 To Range("D1048576").End(xlUp).Row
MyFile = Range("D" & i).Value
Range("E" & i) = NbPages_PDFCreator(MyFile)
Next i
Columns("D:E").AutoFit
End Sub
 
 
Private Function NbPages_PDFCreator(ByVal sFichier As String)
    Dim pdf As Object
    Set pdf = CreateObject("pdfforge.pdf.pdf")
    NbPages_PDFCreator = pdf.NumberOfPages(sFichier)
    Set pdf = Nothing
End Function

Merci beaucoup pour l'aide!

[MatMagik]

un code très efficace trouvé ici https://www.extendoffice.com/documen...age-count.html
pas d'add-on à installer
fonctionne directement

testé avec 200 fichiers et office365

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Test()
    Dim I As Long
    Dim xRg As Range
    Dim xStr As String
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xFileNum As Long
    Dim RegExp As Object
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
        Set xRg = Range("A1")
        Range("A:B").ClearContents
        Range("A1:B1").Font.Bold = True
        xRg = "File Name"
        xRg.Offset(0, 1) = "Pages"
        I = 2
        xStr = ""
        Do While xFileName <> ""
            Cells(I, 1) = xFileName
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "/Type\s*/Page[^s]"
            xFileNum = FreeFile
            Open (xFdItem & xFileName) For Binary As #xFileNum
                xStr = Space(LOF(xFileNum))
                Get #xFileNum, , xStr
            Close #xFileNum
            Cells(I, 2) = RegExp.Execute(xStr).Count
            I = I + 1
            xFileName = Dir
        Loop
        Columns("A:B").AutoFit
    End If
End Sub

dans les commentaires, vous trouverez un code modifié pour parcourir les sous-dossiers