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
| Public Sub InsertImagePDF()
Dim PDFinputFile As String, PDFoutputFile As String
Dim imageFile As String
Dim AcrobatApp As Acrobat.AcroApp
Dim AcroAVDocInput As Acrobat.AcroAVDoc 'PDF à modifier
Dim AcroPDDocInput As Acrobat.AcroPDDoc 'PDF modifié
Dim jso As Object
Dim pageRect As Variant
Dim pageField As Object
Dim fieldRect(0 To 3) As Double
Dim page As Long
Dim CelImage As String
Dim Cel As Range
CelImage = Range("B1").Value 'Lien vers l'image à intégrer
Range("A3", Range("A3").End(xlDown)).Select 'Liste des liens PDF à modifier
For Each Cel In Range("A3", Range("A3").End(xlDown))
If Cel <> "" Then
PDFinputFile = Cel
imageFile = CelImage
PDFoutputFile = Replace(PDFinputFile, ".pdf", " Modif.pdf")
Set AcrobatApp = New Acrobat.AcroApp
Set AcroAVDocInput = New Acrobat.AcroAVDoc
If AcroAVDocInput.Open(PDFinputFile, "") Then
Set AcroPDDocInput = AcroAVDocInput.GetPDDoc()
Set jso = AcroPDDocInput.GetJSObject
For page = 0 To AcroPDDocInput.GetNumPages() - 1
'Obtenir les coordonnées des limites de la page - calcul position du bouton
pageRect = jso.getPageBox("Crop", page)
'Coordonnées du bouton à ajouter - en haut à gauche (x,y), en bas à droite (x,y)
'Etirer en haut à gauche
fieldRect(0) = 30
'Réduire vers la gauche
fieldRect(1) = 660
'Etirer en bas à droite
fieldRect(2) = 580
'Haut - Bas
fieldRect(3) = -590
'Ajout du bouton avec image
Set pageField = jso.addField("button" & page + 1, "button", page, fieldRect)
pageField.buttonImportIcon imageFile
pageField.buttonPosition = jso.Position.iconOnly
pageField.ReadOnly = False
Next
AcroPDDocInput.save 1, PDFoutputFile
AcroAVDocInput.Close True
AcroPDDocInput.Close
'Si besoin, ouverture du PDF modifié
' If AcroAVDocInput.Open(PDFoutputFile, "") Then
' AcrobatApp.Show
' End If
Else
MsgBox "Erreur dans le listing des liens PDF."
End If
Set AcroPDDocInput = Nothing
Set AcroAVDocInput = Nothing
Set AcrobatApp = Nothing
End If
Next Cel
MsgBox "Tous les fichiers PDF ont été modifié !"
End Sub |
Partager