abracadabraPDF › Forums › PDF – Général › Un Script (petit) › Répondre à : Un Script (petit)
Merci Merlin pour le support,
J’ai trouvé et adapté un code qui a l’air de marcher.
Une petite contribution pour les autres, j’ai déjà eu énormément du site, merci :
Les pages doivent être incriminées dans le sens opposé la dernière en premier et la première en dernier.
Bonne soirée
Dim strSourceFullPath As String, strDestinationFullPath As String
Dim iStartPage As Long, iNumPages As Long
Dim PDDocSource As Object, PDDocTarget As Object
Dim Cell As Range, Cell1 As Range, Rng As Range
Application.ScreenUpdating = False
Set PDDocSource = CreateObject(« AcroExch.PDDoc »)
Set PDDocTarget = CreateObject(« AcroExch.PDDoc »)
Set Rng = Range(« a1 », ActiveSheet.Range(« a » & ActiveSheet.Rows.Count).End(xlUp)) ‘ Selection
strSourceFullPath = Application.GetOpenFilename(« PDF Files (*.pdf), *.pdf »)
strDestinationFullPath = StripFilename(strSourceFullPath) & InputBox(« Output FileName ») & « .pdf »
‘ Create a new PDDoc
If PDDocTarget.Create True Then
MsgBox « Unable to create a new PDF »
Exit Sub
End If
‘ Open the PDF source file (the file we are going to take pages from)
If PDDocSource.Open(strSourceFullPath) True Then
MsgBox « Unable to open the source PDF »
Exit Sub
End If
For Each Cell In Rng
‘ Set the page range you wish to delete
‘ Don’t forget that this is zero based
iStartPage = Cell – 1
‘ Set the number of pages you wish to delete
iNumPages = 0
‘ Insert the pages from the source PDF file to the target PDF
If PDDocSource.DeletePages(iStartPage, iStartPage) True Then
MsgBox « Unable to Delete »
Exit Sub
End If
Next Cell
‘ Save the new file
If PDDocSource.Save(&H1, strDestinationFullPath) True Then
MsgBox « Unable to save the pdf »
Exit Sub
End If
‘Close the PDF files
PDDocSource.Close
PDDocTarget.Close
‘ Clean up
Set PDDocSource = Nothing
Set PDDocTarget = Nothing
Application.ScreenUpdating = True
MsgBox « File Saved to » & strDestinationFullPath
End Sub
Function StripFilename(sPathFile As String) As String
‘given a full path and file, strip the filename off the end and return the path
Dim filesystem As Object
Set filesystem = CreateObject(« Scripting.FilesystemObject »)
StripFilename = filesystem.GetParentFolderName(sPathFile) & « »
Exit Function
End Function