Блог

Прежде всего, я хотел бы предварить это, сказав, что у меня меньше недели опыта использования VBA.

Я пытался создать скрипт, который объединяет PDF-файлы, связанные на листе Excel. Код, который у меня есть, работает нормально, однако, когда я добавляю несколько таблиц, разделенных пустыми строками, скрипт продолжит движение вниз по пустым ячейкам и также соберет PDF-файлы из следующей таблицы.

Итак, если я выберу нижнюю таблицу для объединения, она будет работать нормально, но если я выберу верхнюю, она объединит все связанные PDF-файлы для ВСЕХ таблиц, движущихся вниз.

Вот скриншот листа Excel, который у меня есть на данный момент: Лист Excel

Я бы хотел, чтобы скрипт останавливался на первой пустой ячейке, с которой он сталкивается при перемещении вниз по столбцу D, а не продолжался до последней заполненной ячейки. Это означает, что скрипт объединит только одну таблицу PDF-файлов.

Как я уже сказал, это моя первая неделя с использованием любого VBA, поэтому я изо всех сил пытался получить диапазон для завершения слияния PDF, когда он сталкивается с пустой ячейкой.

Любая помощь была бы высоко оценена!

 Sub Button9_Click()

'References
'Adobe Acrobat 10.0 Type Library


    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
    Dim PDFfiles As Range, PDFfile As Range
    Dim n As Long
    Dim em As String

        
    'Set start point of cell range
    'Takes ActiveCell from search results and offsets to filepaths
    
    'CURRENTLY LOOKS FOR LAST POPULATED CELL IN COLUMN, DISREGARDING PREVIOUS EMPTY CELLS
    
        With ActiveSheet
            Set PDFfiles = .Range(ActiveCell.Offset(3, 1), .Cells(.Rows.Count, "D").End(xlUp))
            
        End With
    
    'Create Acrobat API objects
    
        Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
        Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    'Open first PDF file and merge other PDF files into it
    
        n = 0
        For Each PDFfile In PDFfiles
            n = n   1
            If n = 1 Then
                objCAcroPDDocDestination.Open PDFfile.Value
            Else
                objCAcroPDDocSource.Open PDFfile.Value
                If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                    MsgBox "Error merging" amp; PDFfile.Value
                End If
                objCAcroPDDocSource.Close
            End If
        Next
        
    
    'Save merged PDF files as a new file
    
        objCAcroPDDocDestination.Save 1, "C:UsersUSEROneDriveTEST MERGEOutput" amp; Sheets("SEARCH").Range("E6").Value amp; ".pdf"
        objCAcroPDDocDestination.Close
    
        Set objCAcroPDDocSource = Nothing
        Set objCAcroPDDocDestination = Nothing

    'Opens dialogue box for successful/failed merge
    
        MsgBox "Created New PDF (" amp; Sheets("SEARCH").Range("E6").Value amp; ")" amp; vbCrLf amp; vbCrLf amp; "File Path: C:UsersUSEROneDriveTEST MERGEOutput" amp; Sheets("SEARCH").Range("E6").Value amp; ".pdf"
    
    'Opens merged PDF
    
        ActiveWorkbook.FollowHyperlink "C:UsersUSEROneDriveTEST MERGEOutput" amp; Sheets("SEARCH").Range("E6").Value amp; ".pdf"

    

End Sub
  

Попробуйте следующий код, пожалуйста:

 Sub MergePDFDocuments()
 'References to 'Adobe Acrobat 10.0 Type Library
    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc, objCAcroPDDocSource As Acrobat.CAcroPDDoc, i As Long
    Dim PDFfiles As Range, PDFfile As Range, n As Long, em As String, processArr As String, prRng As Range
    Dim sh As Worksheet, startRow As Long, endRow As Long
    
    Set sh = ActiveSheet 'use here your sheet
    processArr = "A" 'the group files to be processed.
                     'It can be "B", or other letter if the workbook will be filled with other groups
    'CURRENTLY LOOKS FOR LAST POPULATED CELL IN COLUMN, DISREGARDING PREVIOUS EMPTY CELLS
    'Set PDFfiles = sh.Range(sh.Offset(3, 1), sh.cells(rows.count, "D").End(xlUp))
    endRow = sh.cells(rows.count, "D").End(xlUp).row
    For i = 2 To endRow
        If sh.Range("C" amp; i).value = "PRODUCT " amp; processArr Then
            startRow = i   2: Exit For
        End If
    Next i
    If startRow >= i Then MsgBox "Strange..." amp; vbCrLf amp; _
                     "The area to be prcessed ""PRODUCT " amp; processArr amp; """ could not be found.": Exit Sub
   
    'Create Acrobat API objects
    Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
    Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    'Open first PDF file and merge other PDF files into it
    For i = startRow To endRow
        n = n   1
        If sh.Range("D" amp; i).value = "" Then Exit For 'iteration is interrupted in case of an empty cell in D:D:
        If n = 1 Then
            objCAcroPDDocDestination.Open sh.Range("D" amp; i).value
        Else
            objCAcroPDDocSource.Open sh.Range("D" amp; i).value
            If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, _
                                        objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                MsgBox "Error merging: " amp; sh.Range("D" amp; i).value
            End If
            objCAcroPDDocSource.Close
        End If
    Next i
            
    'Save merged PDF files as a new file. Here the pdf name can be assorted with the area to be processed (for instance PRODUCT A):
    objCAcroPDDocDestination.Save 1, "C:UsersUSEROneDriveTEST MERGEOutput" amp; Sheets("SEARCH").Range("E6").value amp; ".pdf"
    objCAcroPDDocDestination.Close
    
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing

    'Opens dialogue box for successful/failed merge
    MsgBox "Created New PDF (" amp; Sheets("SEARCH").Range("E6").value amp; ")" amp; vbCrLf amp; vbCrLf amp; "File Path: C:UsersUSEROneDriveTEST MERGEOutput" amp; Sheets("SEARCH").Range("E6").value amp; ".pdf"
    
    'Opens merged PDF
    ActiveWorkbook.FollowHyperlink "C:UsersUSEROneDriveTEST MERGEOutput" amp; Sheets("SEARCH").Range("E6").value amp; ".pdf"
End Sub
  

Вы должны настроить processArr для обработки (A или B с вашего изображения).

Код не протестирован, но он должен работать. Пожалуйста, протестируйте это и отправьте отзыв.