将PDF与VBA结合使用

时间:2016-05-23 12:41:02

标签: arrays excel vba excel-vba pdf

我正在尝试将一个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

我从另一个包含pdfs的X路径的函数中获得了一个字符串数组。我已经验证了这个数组并且它没有任何问题,问题在于此代码。但是我做了一个测试版本,然后重新编写它以适应我的项目,测试版本运行得很好。代码仍然非常相似,我对创建和融合部分没有任何改变。

我首先打开一个oPDDocFinal,这是我的数组“pdfs”(pdfs(0))的第一个pdf然后我循环其余的pdfs数组以创建一个PDDoc数组。最后,我在这个PDDoc数组上循环,将所有这些pdf与oPDDocFinal逐一组合。

但我在这一行上收到了错误:

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

我收到以下错误(我试图翻译法语):

执行错误'91':

对象变量或使用bloc变量undefined

我没有修改这部分代码而且它正在处理我的测试脚本,但现在我收到了这个错误。你知道我怎么解决我的问题?

感谢您的关注。

2 个答案:

答案 0 :(得分:1)

好的,我发现了我的错误:

我的第一个循环,我从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

感谢大家的关注!

答案 1 :(得分:0)

要尝试的事情: -

  • 不工作的环境是否安装了相同版本的AcroExch和Word
  • 这两种环境都能看到PDF吗?
  • 是否存在oPDDocFinal的争用意味着某些东西或其他人将其打开(This thread暗示它应该关闭以进行更新)。
  • 在调试中,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。以上是理论上的。