brawnystaff
Board Regular
- Joined
- Aug 9, 2012
- Messages
- 104
- Office Version
- 365
I am using the macro below to extract pages from a selected PDF. Overall, it work fine if the the cells selected are all in one column (vertical). But, if I select horizontally across a row, it only extracts the first value. I suspected it has to do with LBound to UBound, but not sure how to correct. Any ideas? Thanks.
VBA Code:
Sub Extract_PDF_PageNum()
'extract page numbers from a selected PDF based on numbers in spredsheet
Dim AcroPDDoc As CAcroPDDoc, fd As FileDialog
Dim lrow As Long, pages_arr, pdf_path As String, ipath As String, i As Long
Dim ColSel As Long
Dim myStr
ColSel = Selection.Columns(1).Column
lrow = Cells(Rows.Count, ColSel).End(xlUp).Row
If lrow = 1 Then Exit Sub
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Filters.Add "PDF", "*.pdf"
If fd.Show = -1 Then pdf_path = fd.SelectedItems(1) Else Exit Sub
pages_arr = Selection
For i = LBound(pages_arr) To UBound(pages_arr)
If IsNumeric(pages_arr(i, 1)) Then myStr = myStr & " " & pages_arr(i, 1) - 1 & " " Else myStr = myStr & " " & pages_arr(i, 1) & " "
Next
Set AcroPDDoc = CreateObject("AcroExch.PDDoc")
AcroPDDoc.Open pdf_path
For i = AcroPDDoc.GetNumPages - 1 To 0 Step -1
If InStr(myStr, " " & i & " ") = 0 Then AcroPDDoc.DeletePages i, i
Next
ipath = Mid(pdf_path, 1, InStrRev(pdf_path, Application.PathSeparator)) & InputBox("FileName") & ".pdf"
If AcroPDDoc.Save(PDSaveFull, ipath) = False Then
MsgBox "Cannot save the modified document." & Chr(10) & Err.Description
Exit Sub
Else
MsgBox "New file is successfully created at: " & ipath & " with selected PDF file pages.", vbInformation, "Pages extraction confirmation"
End If
End Sub