Discussion :

[kiki29]

SoftwareBundler win32/stallmonitz s'installe avec certains ( peut-être tous ? ) téléchargements de PDFCreator 1.7.3. Il est Signalé/Mis en quarantaine par Windows Defender. A supprimer.

[kiki29]

Recherche avancée dans tous les PDFs d'un dossier via Acrobat Reader

Selon la version d'Acrobat Reader :

• Acrobat Reader XI ou inférieure : Voir Post#144 et/ou Post#147
• Acrobat Reader DC : Voir Post#165

[vince12]

Bonjour KIKI,

très bon travail, mais j'aurais une question à te posé !

comment récupérer les données de cellules positionnés à différent endroit d'une feuille et les rentrés dans un formulaire pdf, au bon endroit ?

j'ai bien utilisé les codes de la page 3, mais comme je suis novice dans la programmation j'aurais besoin d'aide

merci de ta participation et encore une fois très bon travail.

[kiki29]

Salut, dans les Post#42 et 43 tu as la réponse à ton problème

Cela nécessite d'avoir Acrobat ( pas le Reader ) mais cela tu dois t'en être rendu compte.
Tu connais le nom et type de champ dans le pdf : Set X = JSO.getField("Adresse")
Tu lui affectes la valeur voulue X.Value = CStr(Feuil2.Range("Adresse"))
Ces manips sont à renouveler pour tous les champs.

Après il y a ceci qui permet le dépouillement de formulaires.

[vince12]

Merci kiki,

bon alors là je suis complètement perdu

tu pourrais me donné le code ?

je suis vraiment trop nul

[kiki29]

Tu as avec le post#41 Lecture des champs d'un formulaire PDF la possibilité de lire le nom des champs d'un formulaire et leur type.

Après avec les posts cités plus haut tu modifies et adaptes à ton contexte pour faire concorder les champs de ton formulaire et les données de ta/tes feuilles Excel.

[vince12]

Merci encore Kiki,

bon alors sa marche

Code :

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

1
2
3
4
5
6
7
8
If AVDoc.Open(sChemin, "") Then
        Set PDDoc = AVDoc.GetPDDoc
        Set JSO = PDDoc.GetJSObject
 
        For i = 2 To LastRow
            Set X = JSO.getField("Adresse")
            X.Value = CStr(Feuil2.Range("C7"))
        Next i

comment tu copie pour chaque cellule ?

[vince12]

Oupss

Je suis vraiment trop nul

Merci j'ai trouvé dur dur ce matin

sa le fait pas de ce coucher tard.

[vince12]

Par-contre Kiki

comment tu fait pour enregistré le fichier PDF avec l'année du fichier excel ?

l'enregistré dans un nouveau dossier créer avec l'année toujours du fichier excel ?

le tout avec le même bouton

Merci.

[kiki29]

Pour les fichiers/dossiers tu as Manipulation des fichiers en VBA
sinon Excel et l'enregistreur de macro

En espérant par cela clôturer les verbiages et autres jacasseries inutiles qui viennent polluer ce bazar.

[kiki29]

Acrobat Découpage d'un fichier Pdf en fichiers de n pages

Affecter un bouton à SelFichier

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
Option Explicit
 
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
 
Dim sRacine As String, sDossierPDFs As String
 
Private Function CreationDossier(sDossier) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 
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 Deb As Currency, Fin As Currency, Freq As Currency
Dim sNomfichier As String, FSO As Object, iNbPages As Long, iLast As Long
 
    QueryPerformanceCounter Deb
 
    Nettoyage
    sDossier = sRacine & "\" & sDossierPDFs
 
    Set PDDoc = CreateObject("AcroExch.pdDoc")
 
    If PDDoc.Open(sFichier) Then
        iNumPage = PDDoc.GetNumPages
        iNbPages = Feuil1.Range("NbPages")
        If iNbPages > iNumPage Then
            PDDoc.Close
            Set PDDoc = Nothing
 
            Feuil1.Range("NbPages").Select
            MsgBox "Nb de pages invalide", vbOKOnly + vbInformation
            Exit Sub
        End If
 
        iLast = iNumPage Mod iNbPages
 
        Set FSO = CreateObject("Scripting.FileSystemObject")
        sNomfichier = FSO.GetBaseName(sFichier)
        Set FSO = Nothing
 
        For i = 0 To iNumPage - 1 - iLast Step iNbPages
            Set oPDF = CreateObject("AcroExch.PDDoc")
            oPDF.Create
            sNom = sNomfichier & "_" & Format(i + 1, "000") & "_" & Format(i + iNbPages, "000") & ".pdf"
            With oPDF
                .InsertPages -1, PDDoc, i, iNbPages, 0
                .Save 1, sDossier & "\" & sNom
                .Close
            End With
            Set oPDF = Nothing
            Application.StatusBar = i + 1 & " / " & iNumPage
        Next i
 
        If iLast > 0 Then
            Set oPDF = CreateObject("AcroExch.PDDoc")
            oPDF.Create
            i = iNumPage - iLast
            sNom = sNomfichier & "_" & Format(i + 1, "000") & "_" & Format(i + iLast, "000") & ".pdf"
            With oPDF
                .InsertPages -1, PDDoc, i, iLast, 0
                .Save 1, sDossier & "\" & sNom
                .Close
            End With
            Set oPDF = Nothing
            Application.StatusBar = i + 1 & " / " & iNumPage
        End If
    End If
 
    Set PDDoc = Nothing
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = "Terminé : " & Format((Fin - Deb) / Freq, "0.000 s")
End Sub
 
Private Sub Nettoyage()
Dim FSO As Object
 
    sRacine = ThisWorkbook.Path
    sDossierPDFs = "Split"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(sRacine & "\" & sDossierPDFs) Then _
       FSO.DeleteFolder sRacine & "\" & sDossierPDFs, True
    Set FSO = Nothing
 
    CreationDossier sRacine & "\" & sDossierPDFs
End Sub
 
Sub SelFichier()
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "Sélectionner un Fichier"
        .Filters.Clear
        .Filters.Add "PDF", "*.pdf", 1
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Fichier"
        .Show
        If .SelectedItems.Count > 0 Then
            DoEvents
            DecoupagePDF .SelectedItems(1)
        End If
    End With
End Sub

Téléchargement : ici

[kiki29]

PowerPoint 2003 : Générer un PDF protégé via PDFCreator

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
Option Explicit
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Dim sChemin As String
 
Private Sub Chemin()
Dim JobPDF As Object
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
 
    With JobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation PDFCreator impossible.", vbCritical + _
                                                            vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        sChemin = .coption("AutosaveDirectory")
    End With
 
    Set JobPDF = Nothing
    Kill_PDFCreator
End Sub
 
Private Sub EncryptPDF(sNomFichier As String, sOutputCrypt As String)
Dim Pdf As Object, Crypt As Object
 
    Set Crypt = CreateObject("pdfforge.pdf.PDFEncryptor")
 
    With Crypt
        .AllowAssembly = False
        .AllowCopy = False
        .AllowFillIn = False
        .AllowModifyAnnotations = False
        .AllowModifyContents = False
        .AllowPrinting = True
        .AllowPrintingHighResolution = True
        .AllowScreenReaders = False
        .EncryptionMethod = 2
 
        .OwnerPassword = "master"
        .UserPassword = ""
    End With
 
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    Pdf.EncryptPDFFile sNomFichier, sOutputCrypt, Crypt
    Set Pdf = Nothing
 
    Set Crypt = Nothing
End Sub
 
Sub GénérerPDF()
Dim sNomPdf As String, sPdf As String
Dim sDossier As String
Dim sNomCrypt As String
Dim FSO As Object
 
    sDossier = ActivePresentation.Path
    Chemin
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sNomPdf = FSO.GetBaseName(ActivePresentation.Name) & ".pdf"
    Set FSO = Nothing
    sPdf = sChemin & sNomPdf
 
    With ActivePresentation.PrintOptions
        .RangeType = ppPrintAll
        .NumberOfCopies = 1
        .Collate = msoTrue
        .OutputType = ppPrintOutputSlides
        .PrintHiddenSlides = msoTrue
        .PrintColorType = ppPrintColor
        .FitToPage = msoTrue
        .FrameSlides = msoFalse
        .ActivePrinter = "PDFCreator"
    End With
 
    ActivePresentation.PrintOut
 
    ' A ajuster
    Sleep 2000
 
    sNomCrypt = sDossier & "\" & "Tempo.pdf"
    EncryptPDF sPdf, sNomCrypt
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sPdf) Then Kill sPdf
    If FSO.FileExists(sNomPdf) Then Kill sNomPdf
    Name sNomCrypt As sNomPdf
    Set FSO = Nothing
 
End Sub
 
Private Sub Kill_PDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub

[kiki29]

PowerPoint 2007 : Générer un PDF protégé via PDFCreator

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
Option Explicit
 
Private Sub EncryptPDF(sNomFichier As String, sOutputCrypt As String)
Dim Pdf As Object, Crypt As Object
 
    Set Crypt = CreateObject("pdfforge.pdf.PDFEncryptor")
 
    With Crypt
        .AllowAssembly = False
        .AllowCopy = False
        .AllowFillIn = False
        .AllowModifyAnnotations = False
        .AllowModifyContents = False
        .AllowPrinting = True
        .AllowPrintingHighResolution = True
        .AllowScreenReaders = False
        .EncryptionMethod = 2
 
        .OwnerPassword = "master"
        .UserPassword = ""
    End With
 
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    Pdf.EncryptPDFFile sNomFichier, sOutputCrypt, Crypt
    Set Pdf = Nothing
 
    Set Crypt = Nothing
End Sub
 
Sub GénérerPDF()
Dim sNomPdf As String, sPdf As String
Dim sDossier As String
Dim sNomCrypt As String
Dim FSO As Object
 
    sDossier = ActivePresentation.Path
 
    sNomPdf = Left$(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1) & ".pdf"
    sPdf = sDossier & "\" & sNomPdf
 
    ActivePresentation.ExportAsFixedFormat sPdf, ppFixedFormatTypePDF, ppFixedFormatIntentPrint
 
    sNomCrypt = sDossier & "\" & "Tempo.pdf"
    EncryptPDF sPdf, sNomCrypt
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sPdf) Then Kill sPdf
    If FSO.FileExists(sNomPdf) Then Kill sNomPdf
    Name sNomCrypt As sNomPdf
    Set FSO = Nothing
End Sub

[graphikris]

Bonjour Kiki29,
Je souhaiterai créer à partir d'une feuille Excel, un PDF ne prenant en compte uniquement la sélection de cellules sur cette feuille Excel.

Sur Excel : Feuil1 A115 rempli de données

Je désire créer un Pdf ne prenant que les données A1:O15.

actuellement, je fais fait une sélection A1 à O15 puis, fichier/imprimer : Imprimer la sélection - Centrer Horizontal - Sur une seule Feuille (adapter la sélection à la largeur A4) [Jusque là tout fonctionne]
Puis, je fais enregistrer au format Pdf [Sélection] / [une page en largeur] puis enregistrer.

Le pdf créé n'a pas pris en compte la sélection mais de A1 à P15

Je ne peux pas supprimer la colonne P car elle contient des adresses mails (Copie cachée) qui me servent dans ma macro Excel à envoyer le Pdf aux destinataires (leurs adresses se situent en Colonne O) ainsi qu'a ceux qui sont en colonne P et je ne veux pas que les adresses mails de la colonne P se mettent dans le Pdf.

Cordialement,
Graphikris.

[kiki29]

Salut, il suffit de sélectionner ta zone A1:O15 puis de la définir comme zone d'impression, tout cela en ayant paramétré ta mise en page.

[cheikh98]

Salut Philippe,
ci-joint une version compatible avec Adobe Acrobat Reader DC (version 15).
A+

Bonjour j'ai regardé ta contribution sur la recherche de PDF. J'ai essayé de transposer sur Access et ça marche. Mon, problème maintenant c'est que je voudrais afficher le résultat dans une ListBox mais je rencontre des soucis. Dans mon cas le traitement des fichiers est réalisée mais ensuite rien n'est affiché dans la ListBox.
Pourras tu m'aider si tu t'y connais en VBA Access.

[kiki29]

Salut, voir Utiliser les contrôles dans un UserForm, en VBA Excel, comme précisé dans l'autre post ( pourquoi en changer et venir polluer celui-ci ) je n'ai pas Access.

[Pybou]

Salut kiki29,

tu trouveras peut-être des petites choses qui peuvent t'intéresser sur ce post : http://www.developpez.net/forums/d15...ns-phrase-pdf/.

Ce post donne une méthode pour construire un lien sur une phrase complète dans un PDF.

Tchô

[kiki29]

Acrobat Reader : Sauver un PDF en Texte (accessible) via des SendKeys
Via Acrobat voir post# 2

• Affecter un bouton à la procédure SelectionFichier
• Cocher Microsoft Forms 2.0 Object Library
• Ajuster éventuellement la valeur de Sleep dans la procédure SaveAsText, par défaut est à 2500 ms.

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
Option Explicit
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Function LocaliserAcroReader() As String
Dim FSO As Object
Dim Wsh As Object
Dim sCheminReader As String
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Wsh = CreateObject("WScript.Shell")
 
    sCheminReader = Wsh.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\")
 
    If Not IsNull(FSO.GetAbsolutePathName(sCheminReader)) Then
        LocaliserAcroReader = FSO.GetAbsolutePathName(sCheminReader)
    Else
        LocaliserAcroReader = ""
    End If
 
    Set Wsh = Nothing
    Set FSO = Nothing
End Function
 
Private Sub SaveAsText(sFichier As String)
Dim sAcro As String
Dim Clip As MSForms.DataObject, sNom As String
 
    sNom = "SaveAs_Essai.txt"
 
    Set Clip = New MSForms.DataObject
    Clip.Clear
    Clip.SetText sNom, 1
    Clip.PutInClipboard
 
    sAcro = LocaliserAcroReader
 
    Shell sAcro & " " & sFichier, vbNormalFocus
 
    With CreateObject("WScript.Shell")
        .SendKeys "%h", True
        .SendKeys "s", True
        .SendKeys "x", True
        .SendKeys "^v", True
        .SendKeys "{ENTER}", True
        .SendKeys "o", True
 
        Sleep 2500
 
       .SendKeys "^q", True
    End With
 
    Set Clip = Nothing
End Sub
 
Sub SelectionFichier()
Dim FD As FileDialog
Dim Debut As Currency, Fin As Currency, Freq As Currency
 
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "PDF", "*.pdf", 1
        .ButtonName = "Ouvrir fichier"
        .Title = "Sélectionner un fichier PDF"
    End With
 
    If FD.Show = True Then
        DoEvents
        SaveAsText FD.SelectedItems(1)
    End If
 
    Set FD = Nothing
End Sub

En supprimant la partie presse-papier, donc plus de référence Microsoft Forms 2.0 Object Library à cocher
Le fichier PDF sélectionné sera sauvé sous le même nom mais avec l'extension TXT

La procédure SaveAsText devient :

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
Private Sub SaveAsText(sFichier As String)
Dim sAcro As String
 
    sAcro = LocaliserAcroReader
    Shell sAcro & " " & sFichier, vbNormalFocus
 
    With CreateObject("WScript.Shell")
        .SendKeys "%h", True
        .SendKeys "s", True
        .SendKeys "x", True
        .SendKeys "{ENTER}", True
        .SendKeys "o", True
 
        Sleep 2500
 
       .SendKeys "^q", True
    End With
End Sub

On peut également s'affranchir de la référence à cocher Microsoft Forms 2.0 Object Library en passant tout en Late Binding.

Code :

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

1
2
3
4
5
6
7
8
9
Dim Clip As Object 
    .....
 
    ' Late Binding pour remplacer Set Clip = New MSForms.DataObject
    '    et supprimer référence à cocher : Microsoft Forms 2.0 Object Library
 
    Set Clip = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clip.Clear
    .....

Téléchargeable ici

[kiki29]

Acrobat : Extraction du Texte d'une liste de PDF

En élaguant/combinant Liste des fichiers d'un dossier et le post#2

On aboutit à ceci

Pour le module mPDF

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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
Option Explicit
Option Base 1
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long
Dim Cpt As Long
 
Private Function CreationDossier(sDossier) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 
Private Sub DecompteA()
Dim LastRow As Long, i As Long
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Cpt = 0
    With ShParam
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        For i = LastRow To RDepart Step -1
            If FSO.FileExists(.Cells(1, 1) & "\" & .Cells(i, 2)) Then
                If UCase$(.Cells(i, 1)) = "X" Then Cpt = Cpt + 1
            Else
                .Cells(i, 1) = "o"
            End If
        Next i
    End With
    Set FSO = Nothing
End Sub
 
Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> ""
End Function
 
Private Function LocaliserAcroReader() As String
Dim FSO As Object
Dim Wsh As Object
Dim sCheminReader As String
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Wsh = CreateObject("WScript.Shell")
 
    sCheminReader = Wsh.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\")
 
    If Not IsNull(FSO.GetAbsolutePathName(sCheminReader)) Then
        LocaliserAcroReader = FSO.GetAbsolutePathName(sCheminReader)
    Else
        LocaliserAcroReader = ""
    End If
 
    Set FSO = Nothing
    Set Wsh = Nothing
End Function
 
Sub Pdf2Txt()
Dim sFichier As String
Dim sAcro As String
Dim LastRow As Long, i As Long
Dim iDep As Long
Dim sDossier As String
Dim sDossierTxt As String, sNom As String, sNomfichier As String, FSO As Object
 
    QueryPerformanceCounter Debut
    DoEvents
    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
 
    Application.StatusBar = ""
    sDossier = ShParam.Cells(1, 1)
    bDossier = ShParam.CheckBoxes("chkDossier").Value = 1
    sDossierTxt = ThisWorkbook.Path & "\" & "Essais_Pdf_Txt"
 
    If bDossier Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        If FSO.FolderExists(sDossierTxt) Then _
           FSO.DeleteFolder sDossierTxt, True
        Set FSO = Nothing
        ShParam.CheckBoxes("chkDoublons").Value = 0
    End If
 
    bDoublons = ShParam.CheckBoxes("chkDoublons").Value = 1
 
    CreationDossier sDossierTxt
 
    LastRow = ShParam.Range("A" & Rows.Count).End(xlUp).Row
 
    sAcro = LocaliserAcroReader
 
    If ExistenceFichier(sAcro) = False Then
        MsgBox "Le chemin d'Acrobat Reader est erroné ou" & vbCrLf & "Acrobat Reader n'est pas installé" & vbCrLf & vbCrLf & _
               "Voir la procédure Pdf2Txt du module mPDF" & vbCrLf & "à sAcro = .....", vbInformation + vbOKOnly, "Chemin du Reader erroné"
        Debug.Print sAcro
        Exit Sub
    End If
 
    Application.StatusBar = "Démarrage extraction texte"
    iDep = 0
 
    For i = RDepart To LastRow
        If UCase$(ShParam.Range("A" & i)) = "X" Then
            iDep = iDep + 1
 
            sFichier = sDossier & "\" & ShParam.Range("B" & i)
 
            Set FSO = CreateObject("Scripting.FileSystemObject")
            sNomfichier = FSO.GetBaseName(sFichier)
            sNom = sDossierTxt & "\" & sNomfichier & ".txt"
            Set FSO = Nothing
 
            If bDoublons Then
                sNom = RenommerFichier(sDossierTxt, sNomfichier & ".txt")
            End If
            SavePDFasTxt sFichier, sNom
 
            Application.StatusBar = "Extraction : " & iDep & " / " & Cpt
        End If
        DoEvents
    Next i
 
    With ActiveWindow
        .ScrollColumn = 1
        .ScrollRow = 1
    End With
    DoEvents
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = "Terminé : " & Format((Fin - Debut) / Freq, "0.00 s")
End Sub
 
Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String
Dim sExt As String
Dim iExt As Long
Dim i As Long, Pos As Long
Dim FSO As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        Pos = InStrRev(sNomfichier, ".")
        If Pos > 0 Then
            iExt = Len(sNomfichier) - Pos + 1
            sExt = Right$(sNomfichier, iExt)
            sPre = Left$(sNomfichier, Len(sNomfichier) - iExt)
        Else
            sExt = ""
            sPre = sNomfichier
        End If
 
        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing
 
    RenommerFichier = sDossier & "\" & sNomfichier
End Function
 
Private Sub SavePDFasTxt(sFichier As String, sFichierTxt As String)
Dim AcroXAVDoc As Object
Dim AcroXPDDoc As Object
Dim JSO As Object
 
    Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
    AcroXAVDoc.Open sFichier, "Acrobat"
 
    Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
    Set JSO = AcroXPDDoc.GetJSObject
 
    JSO.SaveAs sFichierTxt, "com.adobe.acrobat.accesstext"
 
    AcroXAVDoc.Close False
 
    Set JSO = Nothing
    Set AcroXPDDoc = Nothing
    Set AcroXAVDoc = Nothing
End Sub