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 |
Partager