Discussion :

[kiki29]

PDFCreator 1.7.3 Numérotation des Pages, En-Tête et Pied de Page

Suite à ce post et en repartant de ceci

Extrait :

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
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
Sub Pdf()
Dim FSO As Object, WshShell As Object, Pdf As Object, i As Long, iLast As Long
Dim sDossier As String, sFichier As String, sNomfichier As String, iNbPages As Long
Dim pdfNumPages As Object, pdfNomFichier As Object, bVide As Boolean, bDoublon As Boolean
Dim sPre As String, sNouveauNom As String, sNomPDF As String
 
    QueryPerformanceCounter Debut
 
    Application.StatusBar = ""
    DecompteA
 
    If Cpt = 0 Then
        MsgBox "Taper dans la colonne A un x ou X en vis à vis" & vbCrLf & _
               "des fichiers à Traiter de la colonne B", vbInformation + vbOKOnly, "x ou X"
        Exit Sub
    End If
 
    bVide = ShParam.CheckBoxes("chkVider").Value = 1
    bDoublon = ShParam.CheckBoxes("chkDoublon").Value = 1
 
    sDossier = ThisWorkbook.Path & "\" & "PDFs"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(sDossier) Then
        If bVide Then FSO.DeleteFolder sDossier, True
    End If
    DoEvents
    If Not (FSO.FolderExists(sDossier)) Then FSO.CreateFolder sDossier
    Set FSO = Nothing
 
    Cpt = 0
    iLast = ShParam.Cells(Rows.Count, "B").End(xlUp).Row
    For i = RDepart To iLast
        If UCase$(ShParam.Range("A" & i)) = "X" Then
            Cpt = Cpt + 1
            sFichier = ShParam.Cells(1, 1) & "\" & ShParam.Cells(i, 2)
            Set FSO = CreateObject("Scripting.FileSystemObject")
            sNomfichier = FSO.GetBaseName(sFichier) & ".pdf"
            sPre = FSO.GetBaseName(sNomfichier)
            Set FSO = Nothing
 
            Set WshShell = CreateObject("WScript.Shell")
            Set Pdf = CreateObject("pdfforge.pdf.pdf")
            iNbPages = NbPages(sFichier)
 
            If bDoublon Then
                sNouveauNom = RenommerFichier(sDossier, sPre & ".pdf")
            Else
                sNouveauNom = sDossier & "\" & sPre & ".pdf"
            End If
 
            Set FSO = CreateObject("Scripting.FileSystemObject")
            sNomPDF = FSO.GetFilename(sNouveauNom)
            Set FSO = Nothing
 
            Set pdfNumPages = CreateObject("pdfforge.pdf.pdfText")
            With pdfNumPages
                .Text = "[PAGE] / [PAGES]"
                '.Text = "[PAGE]"
                .FontColorRed = 0
                .FontColorGreen = 0
                .FontColorBlue = 0
                .FontName = "comic.ttf"
                '.FontName = "comicbd.ttf"
                .FontPath = WshShell.SpecialFolders("Fonts")
                .FontSize = 8
            End With
 
            Set pdfNomFichier = CreateObject("pdfforge.pdf.pdfText")
            With pdfNomFichier
                .Text = sNomPDF
                .FontColorRed = 0
                .FontColorGreen = 0
                .FontColorBlue = 0
                .FontName = "comic.ttf"
                '.FontName = "timesbd.ttf"
                .FontPath = WshShell.SpecialFolders("Fonts")
                .FontSize = 8
            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", sNouveauNom, 1, iNbPages, 1, iNbPages, 4, 5, 5, pdfNomFichier
 
            Application.StatusBar = Cpt & " / " & iLast - RDepart + 1
 
            Kill sDossier & "\" & "Tempo.pdf"
 
            Set pdfNomFichier = Nothing
            Set pdfNumPages = Nothing
            Set Pdf = Nothing
            Set WshShell = Nothing
        End If
    Next i
 
    With ShParam
        .Activate
        .Range("B2").Select
    End With
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = Application.StatusBar & " / Terminé : " & Format(((Fin - Debut) / Freq), "0.00 s")
End Sub

Téléchargement : ici

Mode d'emploi :

1. Cliquer Liste fichiers pour sélectionner le dossier racine.
   
   Le dossier racine étant celui contenant l'ensemble des fichiers à traiter
   La colonne B se remplit
2. Sélectionner dans la colonne A via un "x" les fichiers à traiter.
3. Pagination PDF : Lancera le traitement.

Un dossier baptisé PDFs sera créé automatiquement à la racine de l'appli.
Recherche Récursive ? : Etend la recherche des fichiers dans le dossier racine à tous les sous dossiers s'y trouvant.
Vider Dossier PDFs ? : vide le dossier qui contiendra la copie des fichiers traités
Gérer Doublons PDFs ? : Permet de ne pas écraser les fichiers de même dénomination via l'ajout d'un indice (xxx)

[kiki29]

Acrobat : Numérotation des Pages, En-Tête et Pied de Page

Téléchargeable : ici

Extrait :

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
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
108
109
110
Sub Pdf()
Dim FSO As Object, i As Long, j As Long, iLast As Long, iNb As Long
Dim sDossier As String, sFichier As String, sNomfichier As String, iNbPages As Long
Dim bVide As Boolean, bDoublon As Boolean
Dim sPre As String, sNouveauNom As String, sNomPDF As String
Dim acroApp As Object, DocPDF As Object, JSO As Object
 
    QueryPerformanceCounter Debut
 
    Application.StatusBar = ""
    DecompteA
 
    If Cpt = 0 Then
        MsgBox "Taper dans la colonne A un x ou X en vis à vis" & vbCrLf & _
               "des fichiers à Traiter de la colonne B", vbInformation + vbOKOnly, "x ou X"
        Exit Sub
    End If
 
    bVide = ShParam.CheckBoxes("chkVider").Value = 1
    bDoublon = ShParam.CheckBoxes("chkDoublon").Value = 1
 
    sDossier = ThisWorkbook.Path & "\" & "PDFs"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(sDossier) Then
        If bVide Then FSO.DeleteFolder sDossier, True
    End If
    DoEvents
    If Not (FSO.FolderExists(sDossier)) Then FSO.CreateFolder sDossier
    Set FSO = Nothing
 
    Cpt = 0
    iLast = ShParam.Cells(Rows.Count, "B").End(xlUp).Row
    For i = RDepart To iLast
        If UCase$(ShParam.Range("A" & i)) = "X" Then
            Cpt = Cpt + 1
            sFichier = ShParam.Cells(1, 1) & "\" & ShParam.Cells(i, 2)
 
            Set FSO = CreateObject("Scripting.FileSystemObject")
            sNomfichier = FSO.GetBaseName(sFichier) & ".pdf"
            sPre = FSO.GetBaseName(sNomfichier)
            Set FSO = Nothing
 
            If bDoublon Then
                sNouveauNom = RenommerFichier(sDossier, sPre & ".pdf")
            Else
                sNouveauNom = sDossier & "\" & sPre & ".pdf"
            End If
 
            Set FSO = CreateObject("Scripting.FileSystemObject")
            sNomPDF = FSO.GetFilename(sNouveauNom)
            Set FSO = Nothing
 
            Set acroApp = CreateObject("AcroExch.App")
            Set DocPDF = CreateObject("AcroExch.PDDOc")
 
            DocPDF.Open (sFichier)
 
            Set JSO = DocPDF.GetJSObject
            iNbPages = DocPDF.GetNumPages
            iNb = iLast - RDepart + 1
            ShParam.Cells(i, 1).Select
 
            For j = 1 To iNbPages
                JSO.addWatermarkFromText _
                        cText:=sNomPDF, _
                        cFont:="Comic", _
                        nFontSize:=10, _
                        nTextAlign:=1, _
                        nHorizAlign:=0, _
                        nVertAlign:=4, _
                        nVertValue:=24, _
                        nHorizValue:=5, _
                        nStart:=j - 1, _
                        nEnd:=j - 1
 
                JSO.addWatermarkFromText _
                        cText:=Str(j), _
                        cFont:="Comic", _
                        nFontSize:=10, _
                        nTextAlign:=1, _
                        nHorizAlign:=2, _
                        nVertAlign:=4, _
                        nVertValue:=24, _
                        nHorizValue:=-10, _
                        nStart:=j - 1, _
                        nEnd:=j - 1
 
                Application.StatusBar = Cpt & " / " & iNb & " / " & j
            Next j
 
            DocPDF.Save 1, sDossier & "\" & sNomPDF
 
            Set JSO = Nothing
            acroApp.CloseAllDocs
            Set DocPDF = Nothing
            acroApp.Exit
            Set acroApp = Nothing
        End If
    Next i
 
    With ShParam
        .Activate
        .Range("B2").Select
    End With
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = Application.StatusBar & " : Terminé : " & Format(((Fin - Debut) / Freq), "0.00 s")
End Sub

Pour le paramétrage de addWatermarkFromText :
PDF Téléchargeable ici sinon voir là

Mode d'emploi :

1. Cliquer Liste fichiers pour sélectionner le dossier racine.
   
   Le dossier racine étant celui contenant l'ensemble des fichiers à traiter
   La colonne B se remplit
2. Sélectionner dans la colonne A via un "x" les fichiers à traiter.
3. Pagination PDF : Lancera le traitement.

Un dossier baptisé PDFs sera créé automatiquement à la racine de l'appli.
Recherche Récursive ? : Etend la recherche des fichiers dans le dossier racine à tous les sous dossiers s'y trouvant.
Vider Dossier PDFs ? : Vide le dossier PDFs, avant pagination, ce dossier contiendra les fichiers traités.
Gérer Doublons PDFs ? : Permet de ne pas écraser les fichiers de même dénomination via l'ajout d'un indice (xxx)

Remarque 1 : Très nettement plus lente que la même version sous PDFCreator 1.7.3 ( de 6x à 8x ).
Les fichiers PDF ont tendance à devenir obèses, ce qui est normal puisque l'on ajoute des données aux fichiers. Un exemple : un pdf est passé de 1.4 Mo à 12 Mo !.
Sous PDFCreator c'est aussi le cas mais dans une moindre mesure , le même fichier passe à 4.3 Mo.

Remarque 2 : J'ai aussi une version qui permet de régénérer le pdf via Xpdf en utilisant pdftops.exe puis en lui appliquant un "Smallest File Size.joboptions" pour atteindre une taille minimale mais ... cela prend un temps fou et nécessite de désactiver les warnings OLE "Microsoft Office Excel attend qu'une autre application finisse une action OLE". On perd les bookmarks, les liens deviennent inactifs, bref .....

[kiki29]

Acrobat : Recherche de Mots/Expressions dans un fichier pdf et Extraction des Pages concernées (1)

Suite à ce post

Mode d'Emploi:
Sélection PDF : Permet de sélectionner le fichier PDF à traiter.

Les mots/expressions saisis dans la colonne A seront recherchés dans ce fichier et les N° de Page où ces mots/expressions apparaissent seront inscrits dans la colonne B

Extraction Pages PDF : Permet d'extraire les Pages ( colonne B ) dans un dossier créé automatiquement à la racine de l'appli et baptisé Extractions

Les fichiers seront sauvegardés dans le dossier Extractions sous la forme : Nom du fichier_Mot_N° de Page

Ce qui pour le fichier de test Livraisons Bmk.pdf donnera par exemple Livraisons Bmk_Produit_29.pdf
Si l'on veut gérer les doublons cela se traduira par l'ajout d'un indice, par exemple Livraisons Bmk_Produit_29(001).pdf

Téléchargement ici

Extrait :

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
Private Function RchAdobePdf(sRchStr As String, sNomfichier As String) As String
Dim AcroApp As Object, AcroAVDoc As Object, AcroPDDoc As Object, AcroTextSelect As Object
Dim PageNumber As Object, PageContent As Object, sContent As String, i As Long, j As Long, iNumPages As Long
Dim sResultat As String
 
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
 
    If AcroAVDoc.Open(sNomfichier, vbNull) <> True Then Exit Function
 
    Set AcroPDDoc = AcroAVDoc.GetPDDoc
    iNumPages = AcroPDDoc.GetNumPages
    For i = 0 To iNumPages - 1
        Set PageNumber = AcroPDDoc.AcquirePage(i)
        Set PageContent = CreateObject("AcroExch.HiliteList")
        If PageContent.Add(0, 8000) <> True Then Exit Function
        Set AcroTextSelect = PageNumber.CreatePageHilite(PageContent)
 
        For j = 0 To AcroTextSelect.GetNumText - 1
            sContent = sContent & AcroTextSelect.GetText(j)
        Next j
        If InStr(1, LCase$(sContent), LCase$(sRchStr)) > 0 Then
            sResultat = IIf(sResultat = "", i + 1, sResultat & " " & i + 1)
        End If
        sContent = ""
    Next i
 
    RchAdobePdf = sResultat
 
    AcroAVDoc.Close True
    AcroApp.Exit
 
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
End Function

[pak987]

SALUT

Cela semble vraiment répondre à mon besoin. Malheureusement, je ne peux pas le tester pour le moment car je n'ai pas de poste avec Acrobat sous la main. Je n'ai que le Reader.
Je te tiens informé dans la soirée (Métropole) mais je tiens à te remercier vivement dès maintenant.

Patrick

[kiki29]

Salut, qqs infos sur la dénomination des fichiers

[kiki29]

Acrobat : Recherche de Mots/Expressions dans un fichier pdf et Extraction des Pages concernées (2)

Cette version est une variante de celle-ci.

Téléchargement : ici

Extrait :

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
40
41
42
43
44
Private Function RchMotAdobePdf(sRchStr As String, sNomFichier As String, iRow As Long) As String
Dim AcroApp As Object, AcroAVDoc As Object, AcroPDDoc As Object, AcroTextSelect As Object
Dim PageNum As Object, PageContent As Object, sContent As String, i As Long, j As Long, k As Long, iNumPages As Long
Dim sResultat As String
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
 
    If AcroAVDoc.Open(sNomFichier, vbNull) <> True Then Exit Function
 
    Set AcroPDDoc = AcroAVDoc.GetPDDoc
    iNumPages = AcroPDDoc.GetNumPages
    k = 2
    For i = 0 To iNumPages - 1
        Set PageNum = AcroPDDoc.AcquirePage(i)
        Set PageContent = CreateObject("AcroExch.HiliteList")
        If PageContent.Add(0, 8000) <> True Then Exit Function
        Set AcroTextSelect = PageNum.CreatePageHilite(PageContent)
        For j = 0 To AcroTextSelect.GetNumText - 1
            sContent = sContent & AcroTextSelect.GetText(j)
        Next j
        If bCasse Then
            If InStr(1, sContent, sRchStr) > 0 Then
                shParam.Cells(iRow, k) = i + 1
                EncadrerCellule (shParam.Cells(iRow, k))
                k = k + 1
            End If
        Else
            If InStr(1, LCase$(sContent), LCase$(sRchStr)) > 0 Then
                shParam.Cells(iRow, k) = i + 1
                EncadrerCellule (shParam.Cells(iRow, k))
                k = k + 1
            End If
        End If
        sContent = ""
    Next i
 
    AcroAVDoc.Close True
    AcroApp.Exit
 
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
 
    RchMotAdobePdf = sResultat
End Function

[Pierre Fauconnier]

Salut.

Peux-tu détailler les différences entre les deux versions et préciser si l'une ou l'autre a ta préférence et pourquoi?

[DaSilva-Alexis]

Acrobat : Découpage d'un fichier Pdf en fichiers des pages x à y

Une autre approche : Découpage d'un fichier Pdf en fichiers de n pages

• Le dossier recevant les fichiers est créé automatiquement à la racine de l'appli sous le nom de "Split_02"
• Il y a la possibilité de gérer les éventuels doublons

Téléchargement : ici

Extrait :

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
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
 
Private Sub DecoupagePDF(sFichier As String)
Dim oPdf As Object, PDDoc As Object
Dim iNumPage As Long, sNom As String
Dim i As Long, sDossier As String
Dim Deb As Currency, Fin As Currency, Freq As Currency
Dim sNomfichier As String, FSO As Object, iNb As Long
Dim bChkDoublons As Boolean, iDep As Long, iFin As Long, iDelta As Long
 
    QueryPerformanceCounter Deb
 
    bChkDoublons = Feuil1.CheckBoxes("chkDoublons").Value = 1
    Nettoyage
    sDossier = sRacine & "\" & sDossierPDFs
 
    DecompteA
    If DecompteA = 0 Then
        MsgBox "Taper dans la colonne A un x ou X en vis à vis" & vbCrLf & _
               "des fichiers  à Traiter de la colonne B", vbInformation + vbOKOnly, "x ou X"
        Exit Sub
    End If
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sNomfichier = FSO.GetBaseName(sFichier)
    Set FSO = Nothing
 
    Set PDDoc = CreateObject("AcroExch.pdDoc")
    iNb = Feuil1.Cells(Rows.Count, 2).End(xlUp).Row
 
    If PDDoc.Open(sFichier) Then
        For i = RDepart To iNb
            If UCase$(Feuil1.Cells(i, 1)) = "X" Then
                iDep = Feuil1.Cells(i, 2)
                iFin = Feuil1.Cells(i, 3)
                iDelta = iFin - iDep + 1
                Set oPdf = CreateObject("AcroExch.PDDoc")
                oPdf.Create
                sNom = sNomfichier & "_" & Format(iDep, "000") & "_" & Format(iFin, "000") & ".pdf"
                If bChkDoublons Then sNom = RenommerFichier(sDossier, sNom)
 
                'nInsertPageAfter
                '   The page in the current document after which pages from the source document are inserted.
                '   The first page in a PDDoc object is page 0.
 
                'iPDDocSource
                '   The LPDISPATCH for the AcroExch.PDDoc containing the pages to insert.
                '   iPDDocSource contains the instance variable m_lpDispatch, which contains the LPDISPATCH.
 
                'nStartPage
                '   The first page in iPDDocSource to be inserted into the current document.
 
                'nNumPages
                '   The number of pages to be inserted.
 
                'bBookmarks
                '   If a positive number, bookmarks
 
                With oPdf
                    .InsertPages -1, PDDoc, iDep - 1, iDelta, False
                    .Save 1, sDossier & "\" & sNom
                    .Close
                End With
 
                Set oPdf = Nothing
            End If
            Application.StatusBar = i & " / " & iNb
        Next i
    End If
 
    Set oPdf = Nothing
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = "Terminé : " & Format((Fin - Deb) / Freq, "0.000 s")
End Sub

Bonjour a tous,

Ne touchant pas du tout à la VBA, je souhaiterais savoir si quelqu'un connait la ligne à modifier pour que le fichier fonctionne avec la version 64bit d'EXCEL?

Je vous remercie d'avance!

[DaSilva-Alexis]

En approfondissent mes recherches j'ai trouvé mon bonheur!

J'ai ajouté PtrSafe et ça fonctionne à merveille!!

[kiki29]

Salut, à toi de voir et appliquer : Développer avec Office 64 bits

Même Microsoft déconseille l'installation d'une version 64 bits d'Office.

Office 32 bits est recommandé pour la plupart des utilisateurs
Nous recommandons la version 32 bits d’Office pour la plupart des utilisateurs, car elle offre une plus grande compatibilité avec la plupart des autres applications, en particulier les compléments tiers. C’est la raison pour laquelle la version 32 bits d’Office est installée par défaut, même sur les systèmes d’exploitation Windows 64 bits. Sur ces systèmes, le client Office 32 bits est pris en charge en tant qu’installation Windows-32-on-Windows-64 (WOW64). WOW64 est l’émulateur x86 qui permet l’exécution de façon transparente des applications Windows 32 bits sur les systèmes Windows 64 bits. Cela permet aux utilisateurs de continuer à utiliser les contrôles ActiveX et les compléments COM Microsoft avec la version 32 bits d’Office.

[Geo314]

Bonjour,

Tout d'abord je tiens à vous dire mon admiration quant à votre travail sur la gestion des PDFs avec excel, c'est absolument fabuleux !!! J'utilise souvent des PDFs et entre autre le logiciel split and merge qui est génial également. Mon problème est que je souhaite automatiser certaines procédures au lieu de les faire manuellement avec split and merge. Je sais faire quelques macros sur excel mais cela reste très basique à cause de mon faible niveau.

J'ai bien réussi à utiliser votre procédure : Découpage d'un fichier Pdf en fichiers unitaires et elle marche très bien !

Mais je souhaiterais automatiser cette procédure de découpage : dans un répertoire, j'ai 700 fichiers PDFs. J'aimerais avoir un bouton qui créée un répertoire de même nom que chaque fichier pdf et qui découpe en fichier unitaire dans chaque répertoire associé. Si j'ai un fichier 1906.pdf, j'aimerais qu'il créé un répertoire 1906 et qu'il découpe à l'intérieur en fichier unitaire de type 1_1906.pdf 2_1906.pdf 3_1906.pdf... puis si j'ai un fichier 1907.pdf, qu'il créé un répertoire 1907 et qu'il découpe à l'intérieur en fichier unitaire de type 1_1907.pdf 2_1907.pdf 3_1907.pdf

Je pense que pour vous ce n'est pas difficile à modéliser alors que pour moi c'est quasiment impossible.

Merci de votre aide !

[kiki29]

Acrobat : Découpage de fichiers Pdf en fichiers unitaires

Salut, cela devrait correspondre à tes doléances.

Dans un répertoire, j'ai 700 fichiers PDFs. J'aimerais avoir un bouton qui crée un répertoire de même nom que chaque fichier pdf et qui découpe en fichier unitaire dans chaque répertoire associé.
Si j'ai un fichier 1906.pdf, j'aimerais qu'il crée un répertoire 1906 et qu'il soit découpé à l'intérieur en fichiers unitaires de type 1_1906.pdf 2_1906.pdf 3_1906.pdf etc

Extrait :

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
40
41
Private Sub DecoupagePDF(sFichier As String)
Dim PDDoc As Object
Dim oPDF As Object
Dim iNumPage As Long, sNom As String
Dim i As Long, sDossier As String
Dim sNomfichier As String, FSO As Object
Dim bChkDoublons As Boolean
 
    bChkDoublons = ShParam.CheckBoxes("chkDoublons").Value = 1
    Nettoyage sFichier, iRow
 
    sDossier = sRacine & "\" & sDossierPDFs
    Set PDDoc = CreateObject("AcroExch.pdDoc")
 
    If PDDoc.Open(sFichier) Then
        iNumPage = PDDoc.GetNumPages
 
        Set FSO = CreateObject("Scripting.FileSystemObject")
        sNomfichier = FSO.GetBaseName(sFichier)
        Set FSO = Nothing
 
        For i = 0 To iNumPage - 1
            Set oPDF = CreateObject("AcroExch.PDDoc")
            oPDF.Create
 
            sNom = Format(i + 1, "00000") & "_" & sNomfichier & ".pdf"
            If bChkDoublons Then sNom = RenommerFichier(sDossier, sNom)
 
            With oPDF
                .InsertPages -1, PDDoc, i, 1, 0
                .Save 1, sDossier & "\" & sNom
                .Close
            End With
 
            Set oPDF = Nothing
            Application.StatusBar = i + 1 & " / " & iNumPage
        Next i
    End If
 
    Set PDDoc = Nothing
End Sub

Téléchargement ici

[Geo314]

Je vous remercie infiniment pour votre programme qui exécute exactement ce dont j'avais besoin !!!

Vous me faites gagner des heures de travail, soyez-en mille fois remercié.

Et encore une fois félicitations pour tout votre travail sur la gestion des PDFs avec Excel, c'est vraiment excellent.

[kiki29]

PDFCreator 1.7.3 : Découpage de fichiers Pdf en fichiers unitaires

Remarque : cette version peut s'avérer très très nettement plus lente que la version Acrobat.

Dans un répertoire, j'ai 700 fichiers PDFs. J'aimerais avoir un bouton qui crée un répertoire de même nom que chaque fichier pdf et qui découpe en fichier unitaire dans chaque répertoire associé.
Si j'ai un fichier 1906.pdf, j'aimerais qu'il crée un répertoire 1906 et qu'il soit découpé à l'intérieur en fichiers unitaires de type 1_1906.pdf 2_1906.pdf 3_1906.pdf etc

Extrait :

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
Private Sub DecoupagePDFCreator(sFichier As String, iRow As Long)
Dim PDF As Object
Dim sNom As String
Dim i As Long, sDossier As String
Dim sNomfichier As String, FSO As Object, iNbPages As Long
Dim bChkDoublons As Boolean
 
    bChkDoublons = ShParam.CheckBoxes("chkDoublons").Value = 1
 
    Nettoyage sFichier, iRow
    If bExist = False Then Exit Sub
 
    sDossier = sRacine & "\" & sDossierPDFs
 
    iNbPages = NbPagesPDFCreator(sFichier)
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sNomfichier = FSO.GetBaseName(sFichier)
    Set FSO = Nothing
 
    Set PDF = CreateObject("pdfforge.Pdf.Pdf")
 
    For i = 1 To iNbPages
        sNom = Format(i, "00000") & "_" & sNomfichier & ".pdf"
        If bChkDoublons Then sNom = RenommerFichier(sDossier, sNom)
 
        PDF.CopyPDFFile sFichier, sDossier & "\" & sNom, i, i
 
        Application.StatusBar = iRow & " / " & i & " / " & iNbPages
    Next i
 
    Set PDF = Nothing
End Sub

Téléchargement ici

[kiki29]

Acrobat : Liste des Signets/Bookmarks d'un fichier PDF

Nécessite Acrobat ( pas le Reader )

Le fichier PDF ayant été sélectionné, la liste des signets est générée et sauvegardée dans un dossier baptisé BKMs, créé automatiquement à la racine de l'appli. Ce fichier *.XLS reprenant le nom du fichier PDF sélectionné. On peut envisager un découpage suivant les signets/bookmarks.

• Acrobat : Découpage d'un fichier Pdf en fichiers des pages x à y
• PDFCreator : Découpage d'un fichier Pdf en fichiers des pages x à y

Extrait :

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub ListeBMKs(sFichier As String)
Dim FSO As Object, AcroApp As Object, AForm As Object
Dim AVDoc As Object, PDDoc As Object, JSO As Object, sScript As String
Dim sStr As String, sNomFichierCSV As String, Fichier As Object, Tablo As Variant, i As Long
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    Set AcroApp = CreateObject("AcroExch.App")
    Set AVDoc = CreateObject("AcroExch.AVDoc")
 
    If (AVDoc.Open(sFichier, "")) Then
        Set AVDoc = AcroApp.GetActiveDoc()
        Set PDDoc = AVDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject
 
        sScript = "  var sStr = """";  " & vbLf _
                  & "  function DumpBookmark(bkm, nLevel)  " & vbLf _
                  & "  {  " & vbLf _
                  & "  var s = """";  " & vbLf _
                  & "  for (var i = 0; i < nLevel; i++)  " & vbLf _
                  & "      s += """"; " & vbLf _
                  & "      if (nLevel >0){  " & vbLf _
                  & "        bkm.execute();  " & vbLf _
                  & "        p = this.getPageLabel(this.pageNum);  " & vbLf _
                  & "        l = nLevel -1;  " & vbLf _
                  & "        sStr += (+p +"";"" +l +"";"" +s + bkm.name +""|"");}  " & vbLf _
                  & "      if (bkm.children != null)  " & vbLf _
                  & "        for (var i = 0; i < bkm.children.length; i++)  " & vbLf _
                  & "        DumpBookmark(bkm.children[i], nLevel + 1);  " & vbLf _
                  & "  }  " & vbLf _
                  & "  DumpBookmark(this.bookmarkRoot, 0);  "
 
        Set AForm = CreateObject("AFormAut.App")
        AForm.Fields.ExecuteThisJavaScript sScript
 
        sStr = JSO.sStr
 
        sNomFichierCSV = sDossierBkm & "\" & FSO.GetBaseName(sFichier) & ".csv"
 
        Set Fichier = FSO.OpenTextFile(sNomFichierCSV, 2, True)
        Tablo = Split(sStr, "|")
        Fichier.WriteLine "Page;Niveau;Intitulé"
        For i = 0 To UBound(Tablo) - 1
            Fichier.WriteLine Tablo(i)
        Next i
        Fichier.Close
 
        Csv2Xls sNomFichierCSV
    End If
 
    AVDoc.Close True
    AcroApp.CloseAllDocs
    AcroApp.Exit
 
    Set JSO = Nothing
    Set PDDoc = Nothing
    Set AVDoc = Nothing
    Set AForm = Nothing
    Set AcroApp = Nothing
End Sub

Téléchargement : Acrobat : Liste des Signets/Bookmarks d'un fichier PDF

A voir également :

• Insertion de Données Excel dans des Signets
• Supprimer les signets d'un PDF
• Création Arborescence de Signets et Insertion de Données Excel dans ces Signets
• Téléchargement : Création des Signets d'un fichier Pdf avec Acrobat Pro via Excel

[kiki29]

Pour répondre à une question externe concernant un message d'erreur possible, il convient d'activer JavaScript dans les Préférences d'Acrobat.

[kiki29]

Acrobat : Découpage d'un fichier PDF aux Signets/Bookmarks

Le fichier PDF ayant été sélectionné via Liste Signets PDF, la liste de ces Signets est générée et sauvegardée dans un dossier baptisé BKMs_XLS créé automatiquement à la racine de l'appli. Le fichier *.xls des Signets/Bookmarks reprend le nom du fichier PDF sélectionné.
Ce fichier contient le N° de page, le Niveau dans l'arborescence et l'intitulé des signets.
Le Découpage PDF entraine la création automatique d'un dossier Split_BKMs qui contiendra le fichier PDF scindé suivant les Signets/Bookmarks, avec ou non les N° de pages et le traitement des doublons éventuels.

Téléchargeable: ici

On peut donc, par exemple, envisager une découpe au top ( càd au niveau 0 ) des bookmarks.

[kiki29]

Acrobat : Découpage d'un fichier PDF aux Signets/Bookmarks du 1er niveau

Nécessite Acrobat ( pas le Reader )

Le fichier PDF ayant été sélectionné via Liste Signets PDF, la liste de ces Signets est générée et sauvegardée dans un dossier baptisé BKMs_XLS créé automatiquement à la racine de l'appli. Le fichier *.xls des Signets/Bookmarks reprend le nom du fichier PDF sélectionné. Ce fichier *.xls contient le N° de page et l'intitulé des signets du 1er niveau (0).

Le Découpage PDF entraine la création automatique d'un dossier principal Split_BKMs_02 avec un sous-dossier, portant le nom du fichier, qui contiendra le fichier PDF scindé suivant les Signets/Bookmarks du 1er niveau (0), avec ou non les N° de pages et le traitement automatique des doublons éventuels via un indice (001)(002)(003) etc.

Téléchargeable :ici

[JFr.Ruelle]

Bonjour

J'ai installé PDFCreator,

mais à l'instruction

Code :

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

Set pdf = CreateObject("pdfforge.pdf.pdf")

J'ai un message d'erreur

Un composant activeX ne peux pas créer d'objet

Vous pouvez m'aider ? :-)

Merci

[kiki29]

Salut, tous les codes utilisant PDFCreator fonctionnent avec PDFCreator 1.7.3 ( pas les 1.9 2.x 3.x etc )

Un futur possible patron, me demande si je peux écrire une macro, qui permette de mettre un tampon avec le Texte ( Pour accord) dans un PDF, qui est un scan d'un document

En réponse au MP :

Acrobat : Ajout d'un filigrane ( watermark ) à partir d'un texte
Acrobat : Ajout d'un filigrane ( watermark ) à partir d'un fichier pdf
Acrobat : Insertion d'un arrière plan Pdf dans un Document Pdf
PDFCreator Insertion Image de fond dans Document Pdf

Pour le paramétrage de addWatermarkFromText et addWatermarkFromText voir dans la doc js_api_reference.pdf téléchargeable ici

Cette Liste des contributions et téléchargements à consulter, pour naviguer dans le bazar.