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 |
, maintenant il ne me manque que la fusion de plusieurs pdf en un seul.
Envoyé par kiki29
Partager