Excel VBA - Selection across Row

brawnystaff

Board Regular
Joined
Aug 9, 2012
Messages
88
Office Version
  1. 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
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Watch MrExcel Video

Forum statistics

Threads
1,118,295
Messages
5,571,394
Members
412,386
Latest member
Yasaman
Top