Объедините PDF с VBA

Я пытаюсь объединить массив PDF в один с этим кодом:

Option Explicit

Sub Fusion_PDFs(ByVal name As String, ByRef pdfs() As Variant)

Dim oPDDoc() As Object
Dim oPDDocFinal As Object
Dim Num As Long
Dim i As Integer

    Set oPDDocFinal = CreateObject("AcroExch.PDDoc")
    oPDDocFinal.Open (pdfs(0))

    ReDim oPDDoc(UBound(pdfs))

    For i = LBound(pdfs) + 1 To UBound(pdfs)

        Set oPDDoc(i) = CreateObject("AcroExch.PDDoc")
        oPDDoc(i).Open (pdfs(i))

    Next i

    For i = LBound(oPDDoc) To UBound(oPDDoc)

        Num = oPDDocFinal.GetNumPages() - 1

        oPDDocFinal.InsertPages Num, oPDDoc(i), 0, oPDDoc(i).GetNumPages(), True

    Next i


    oPDDocFinal.Save 1, ThisWorkbook.Path & "\DRT créés\" & name & ".pdf"

    'Application.DisplayAlerts = False

    For i = LBound(oPDDoc) To UBound(oPDDoc)

        oPDDoc(i).Close
        Set oPDDoc(i) = Nothing

    Next i

    oPDDocFinal.Close
    Set oPDDocFinal = Nothing

    'Application.DisplayAlerts = True

End Sub

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

Сначала я открываю oPDDocFinal, который является первым pdf моего массива "pdfs" (pdfs(0)), затем я делаю цикл на остальной части массива pdfs, чтобы создать массив PDDoc. Наконец, я зациклился на этом массиве PDDoc, чтобы объединить один за другим все тезисы pdf с oPDDocFinal

Но я получил ошибку в этой строке:

oPDDocFinal.InsertPages Num, oPDDoc(i), 0, oPDDoc(i).GetNumPages(), True

я получил следующую ошибку (я пытался перевести с французского):

Ошибка выполнения '91':

Переменная объекта или переменная блока не определена

Я не модифицировал эту часть кода, и она работала над моим тестовым скриптом, но теперь я получаю эту ошибку. Вы знаете, как я могу решить мою проблему?

Спасибо за внимание.

2 ответа

Решение

Хорошо, я нашел свою ошибку:

Мой первый цикл начинается с 1, поэтому я беру pdfs(1) в oPDDoc(1), но мой первый цикл начинается с 0, поэтому oPDDoc(0) не существует.

Я исправил это так, и теперь это работает:

Option Explicit

Sub Fusion_PDFs(ByVal name As String, ByRef pdfs() As Variant)

Dim oPDDoc() As Object
Dim oPDDocFinal As Object
Dim Num As Long
Dim i As Integer

    Set oPDDocFinal = CreateObject("AcroExch.PDDoc")
    oPDDocFinal.Open (pdfs(0))

    ReDim oPDDoc(UBound(pdfs))

    For i = LBound(pdfs) + 1 To UBound(pdfs)

        Set oPDDoc(i - 1) = CreateObject("AcroExch.PDDoc")
        oPDDoc(i - 1).Open (pdfs(i))

    Next i


    For i = LBound(oPDDoc) To UBound(oPDDoc) - 1

        Num = oPDDocFinal.GetNumPages() - 1

        oPDDocFinal.InsertPages Num, oPDDoc(i), 0, oPDDoc(i).GetNumPages(), True

    Next i


    oPDDocFinal.Save 1, ThisWorkbook.Path & "\DRT créés\" & name & ".pdf"

    'Application.DisplayAlerts = False

    'For i = LBound(oPDDoc) To UBound(oPDDoc) - 1
    '
    '    oPDDoc(i).Close
    '   Set oPDDoc(i) = Nothing
    '
    'Next i
    '
    'oPDDocFinal.Close
    'Set oPDDocFinal = Nothing

    'Application.DisplayAlerts = True

End Sub

Спасибо всем за внимание!

Что попробовать:-

  • Установлена ​​ли в среде, в которой она не работает, одна и та же версия AcroExch и Word?
  • Могут ли обе среды видеть PDF-файлы?
  • Есть ли спор о том, что oPDDocFinal означает, что что-то или кто-то еще имеет его открытым ( этот поток подразумевает, что он должен быть закрыт для обновления).
  • В отладке, имеет ли значение oPDDoc(i)
  • это должно быть в скобках - oPDDocFinal.InsertPages(Num, oPDDoc(i), 0, oPDDoc(i).GetNumPages(), True)

Я также считаю, что вам может быть проще отладки в одном цикле.

Dim oPDDoc      As Object
Dim oPDDocFinal As Object
Dim Num         As Long
Dim i           As Integer

'Initialise objects
Set oPDDocFinal = CreateObject("AcroExch.PDDoc")
Set oPDDoc = CreateObject("AcroExch.PDDoc")

'Save a working copy
oPDDocFinal.Open (pdfs(0))
oPDDocFinal.Save 1, ThisWorkbook.Path & "\DRT créés\" & name & ".pdf"
oPDDocFinal.Close

'Reference the working copy
pdfs(0) = ThisWorkbook.Path & "\DRT créés\" & name & ".pdf"

'for all but the first item in the pdfs array
For i = LBound(pdfs) + 1 To UBound(pdfs)

    'Open the working copy
    oPDDocFinal.Open (pdfs(0))

    'Open the additional PDF
    oPDDoc.Open (pdfs(i))

    'Get the page count of the working copy
    Num = oPDDocFinal.GetNumPages() - 1

    'Insert the additional PDF at the end of the working copy
    oPDDocFinal.InsertPages Num, oPDDoc(i), 0, oPDDoc(i).GetNumPages(), True

   'Close the additional PDF
   oPDDoc.Close

   'Save and close the working copy PDF
   oPDDocFinal.Save
   oPDDocFinal.Close 

Next i

'Release objects
 Set oPDDocFinal = Nothing
 Set oPDDoc = Nothing

Это будет тяжелый цикл, но он должен служить отправной точкой для отладки. Я должен также добавить, что у меня нет AcroExch, Вышесказанное является теоретическим.

Другие вопросы по тегам