Объединение файлов PDF в 3 файла PDF

#excel #vba

#excel #vba

Вопрос:

У меня есть следующий код, который объединяет файлы PDF в папке в одну папку PDF

 Sub PDFs_Combine_LateBound()
Dim PdfDst As Object, PdfSrc As Object
Dim sPdfComb As String, sPdf As String
Dim b As Byte

    Rem Set Combined Pdf filename - save the combined pdf in a new file in order to preserve original pdfs
    sPdfComb = ThisWorkbook.Path amp; "" amp; "Pdf Combined" amp; Format(Now, " mmdd_hhmm ") amp; ".pdf"   'change as required

    Rem Open Destination Pdf
    b = 1
    sPdf = ThisWorkbook.Path amp; "" amp; "firstpdf" amp; b amp; ".pdf"
    Set PdfDst = CreateObject("AcroExch.PDDoc")
    If Not (PdfDst.Open(sPdf)) Then
        MsgBox "Error opening destination pdf:" amp; vbCrLf _
            amp; vbCrLf amp; "[" amp; sPdf amp; "]" amp; vbCrLf _
            amp; vbCrLf amp; vbTab amp; "Procees will be cancelled!", vbCritical
        Exit Sub
    End If

    Do

        Rem Set amp; Validate Source filename
        b = b   1
        sPdf = ThisWorkbook.Path amp; "" amp; "firstpdf" amp; b amp; ".pdf"
        If Dir(sPdf, vbArchive) = vbNullString Then Exit Do

        Rem Open Source filename
        Set PdfSrc = CreateObject("AcroExch.PDDoc")
        If Not (PdfSrc.Open(sPdf)) Then
            MsgBox "Error opening source pdf:" amp; vbCrLf _
                amp; vbCrLf amp; "[" amp; sPdf amp; "]" amp; vbCrLf _
                amp; vbCrLf amp; vbTab amp; "Procees will be cancelled!", vbCritical
            GoTo Exit_Sub
        End If

        With PdfDst

            Rem Insert Source filename pages
            If Not (.InsertPages(-1   .GetNumPages, PdfSrc, 0, PdfSrc.GetNumPages, 0)) Then
                MsgBox "Error inserting source pdf:" amp; vbCrLf _
                    amp; vbCrLf amp; "[" amp; sPdf amp; "]" amp; vbCrLf _
                    amp; vbCrLf amp; vbTab amp; "Procees will be cancelled!", vbCritical
                GoTo Exit_Sub
            End If

            Rem Save Combined Pdf
            If Not (.Save(1, sPdfComb)) Then
                MsgBox "Error saving combined pdf:" amp; vbCrLf _
                    amp; vbCrLf amp; "[" amp; sPdfComb amp; "]" amp; vbCrLf _
                    amp; vbCrLf amp; vbTab amp; "Procees will be cancelled!", vbCritical
                GoTo Exit_Sub
            End If

            PdfSrc.Close
            Set PdfSrc = Nothing

        End With

'        sPdf = Dir(sPdf, vbArchive)
'    Loop While sPdf <> vbNullString
    Loop

    MsgBox "Pdf files combined successfully!", vbExclamation

Exit_Sub:
    PdfDst.Close

   End Sub
  

Код работает нормально, как для объединения файлов PDF

Но то, что мне нужно, немного отличается, скажем, у меня есть 5 файлов PDF с 3 страницами в каждом PDF .. и мне нужно объединить первую страницу из всех файлов, и это первый выходной PDF, затем возьмите вторую страницу для всех файлов и объедините, чтобы получить второй выходной PDF. Затем возьмите третью страницу для всех файлов и объедините, чтобы получить третий выходной PDF-файл.

Таким образом, конечным результатом будет три файла PDF..

Комментарии:

1. Измените Do While на цикл For с вложенным циклом For, а затем объедините страницы в порядке слоев.

2. Можете ли вы помочь мне, отправив ответ, поскольку я не смог его применить?