目前,我有将pdf组合在一起的代码。 它从我在A3:A5列中指定的每个文件中提取所有页面,然后追加到A2。
可以说我所有的pdf都有5页。但是,如果我只想获取前3个A3,完整5页的A4和1页A5怎么办?
我也不需要在页面之间进行指定,即A3的2,4和5。 它将始终保持顺序,即1-3或1-5或1-2。
我有一个计数器,该计数器已经可以获取页数
Dim i As Long, pgnumber As Range
For Each pgnumber In Range("A2:A100")
If Not IsEmpty(pgnumber) Then
i = i + 1
AcroDoc.Open pgnumber
PageNum = AcroDoc.GetNumPages
Cells(pgnumber.Row, 4) = PageNum
End If
AcroDoc.Close
Next pgnumber
完整代码:
Sub main3()
Set app = CreateObject("Acroexch.app")
Dim FilePaths As Collection
Set FilePaths = New Collection
Dim AcroDoc As Object
Set AcroDoc = New AcroPDDoc
'Counts # of pages in each pdf, loads to column D.
Dim i As Long, pgnumber As Range
For Each pgnumber In Range("A2:A100")
If Not IsEmpty(pgnumber) Then
i = i + 1
AcroDoc.Open pgnumber
PageNum = AcroDoc.GetNumPages
Cells(pgnumber.Row, 4) = PageNum
End If
AcroDoc.Close
Next pgnumber
'Append to this file, ideally will be a front page to append to, commented out for now.
'FilePaths.Add "\path\name\here"
'Active or not feature in Column B, Specify Yes to include in combination, no to exclude
Dim cell As Range
For Each cell In Range("A2:A100")
If cell.Offset(0, 1).Value2 <> "No" Then FilePaths.Add cell.Value2
Next cell
'Combine files which are listed in Column A.
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(FilePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For colIndex = 2 To FilePaths.Count
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(FilePaths(colIndex))
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
numberOfPagesToInsert = sourceDoc.GetNumPages
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, numberOfPagesToInsert, False)
Debug.Print "(" & colIndex & ") PAGES INSERTED SUCCESSFULLY: " & OK
Set sourceDoc = Nothing
Next colIndex
OK = primaryDoc.Save(PDSaveFull, FilePaths(1))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub
在实现此目标方面的任何帮助将不胜感激。
尝试了以下代码,但没有任何效果:
'attempt to do start and end page in col E and F.
startPage = Range("E" & colIndex)
endPage = Range("F" & colIndex)
OK = sourceDoc.DeletePages(1, startPage - 1)
OK = sourceDoc.DeletePages(endPage - startPage + 2, sourceDoc.GetNumPages)
答案 0 :(得分:1)
例如,您可以尝试删除每个pdf中不需要的部分,然后将它们全部与sourceDoc.DeletePages(startPage, endPage)
附加在一起,例如:
OK = sourceDoc.Open(FilePaths(colIndex))
startPage = Range("C" & colIndex)
endPage = Range("D" & colIndex)
OK = sourceDoc.DeletePages(1, startPage - 1)
OK = sourceDoc.DeletePages(endPage - startPage + 2, sourceDoc.GetNumPages) ' just some arithmetic
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
您只需要在C和D列中分别为startPage
和endPage
指定...,或者您可以根据自己的喜好更改此代码段并具体说明
答案 1 :(得分:1)
下面有一个更接近完整的答案
请参阅我对您问题的评论。如果正确,则可以解决问题:
添加:
Dim FileRows As Collection
Set FileRows = New Collection
更改
If cell.Offset(0, 1).Value2 <> "No" Then FilePaths.Add cell.Value2
收件人:
If cell.Offset(0, 1).Value2 <> "No" Then
FilePaths.Add cell.Value2
FileRows.Add cell.Row
Endif
更改:
startPage = Range("E" & colIndex)
endPage = Range("F" & colIndex)
收件人:
startPage = Range("E" & FileRows(colIndex))
endPage = Range("F" & FileRows(colIndex))
好的,我知道我不应该这样做,但是我们开始吧。我已经修改了您的代码,使其能够按照我认为的方式工作。这不是一个完整的修订版,因为整个过程可以一次完成,而集合对象可以被淘汰。以下代码可能存在错误,因为我没有Adobe Acrobat SDK。但是,我认为它可以使您比以前更紧密,并且可以将所有内容放置到位。您应该可以从此处进行任何调试:
Sub CompileDocuments()
Dim acroExchangeApp as Object ' Needed because?
Dim filePaths As Collection ' Paths for PDFs to append
Dim fileRows As Collection ' Row numbers PDFs to append
Dim fileIndex as Long ' For walking through the collections
Dim acroDoc As AcroPDDoc ' Manages imported PDFs
Dim sourceDoc as Object ' Manages imported PDFs (Same as above?)
Dim primaryDoc As Object ' Everything gets appended to this
Dim importPath As Range ' Cell containing a PDF to append
Dim pageCount As Long ' Total pages in an appendable PDF
Dim insertPoint as Long ' PDFs will be appended after this page in the primary Doc
Dim startPage as Long ' First desired page of appended PDF
Dim endPage as Long ' Last desired page of appended PDF
' Initialize
Set filePaths = New Collection
Set fileRows = New Collection
Set acroDoc = New AcroPDDoc
Set acroExchangeApp = CreateObject("Acroexch.app")
Set primaryDoc = CreateObject("AcroExch.PDDoc")
' Pass through rows setting page numbers and capturing paths
For Each importPath In Range("A2:A100")
' Put the page count of each PDF document in column D
If Not IsEmpty(importPath) Then
acroDoc.Open importPath
pageCount = acroDoc.GetNumPages
importPath.OffSet(0,3) = pageCount
acroDoc.Close
End If
Set acroDoc = Nothing
' Remember which documents to append and the row on which they appear
' Skipping any rows with "No" in column B
If importPath.Offset(0, 1).Value2 <> "No" Then
filePaths.Add importPath.Value2
fileRows.Add importPath.Row
End If
Next importPath
' Combine all file listed in Column A.
' Start by opening the file in A2.
OK = primaryDoc.Open(filePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
' Loop through the remaining files, appending pages to A2
' Note that columns E and F define the desired pages to extract from
' the appended document.
For fileIndex = 2 To filePaths.Count
' Pages will be added after this insert point
insertPoint = primaryDoc.GetNumPages() - 1
' Open the source document
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(filePaths(fileIndex))
Debug.Print "(" & fileIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
' Get start and end pages
startPage = Range("E" & CStr(fileRows(fileIndex))).Value
endPage = Range("F" & CStr(fileRows(fileIndex))).Value
OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage-startPage+1, False)
Debug.Print "(" & fileIndex & ") " & endPage-startPage+1 & " PAGES INSERTED SUCCESSFULLY: " & OK
Set sourceDoc = Nothing
Next fileIndex
OK = primaryDoc.Save(PDSaveFull, filePaths(1))
Debug.Print "primaryDoc SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
acroExchangeApp.Exit
Set acroExchangeApp = Nothing
MsgBox "DONE"
End Sub
答案 2 :(得分:1)
EXPLANATION:
对于第一个代码,我删除了除了准系统之外的所有内容:要添加到文档的文件路径和要获取要添加到主要文档的页面的文件路径。
我为我们设置了一个常量,并将其设置为2。我们可以将其设置为3或5,等等。此常量将在insertpage函数的PAGE TO END部分中传递。我觉得您会说pdf中的总页数与要追加的页数之间存在某种关系,但这在OP中并不明确
BREAKING DOWN INSERTPAGES():
INSERTPAGES(插入开始的页码(在primaryDoc内),作为插入页面来源的PDF路径(sourcedoc路径),从其开始的页面(sourceDoc),从页面到结束的页面(sourceDoc),true是否也插入书籍为false
代码准系统:
Option Explicit
Sub AppendPDF()
Dim app As Object
Dim acroDoc As Object
Dim filePaths As Collection
Dim pathwayIterator As Range
Dim primaryDoc As Object
Dim OK As String
Dim numPages As Long
Dim colIndex As Long
Dim sourceDoc As Object
Const finalPage = 2
Set app = CreateObject("Acroexch.app")
Set acroDoc = New AcroPDDoc
Set filePaths = New Collection
For Each pathwayIterator In Range("A2:A100")
If pathwayIterator.Value <> "" Then
filePaths.Add pathwayIterator.Value2
End If
Next pathwayIterator
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(filePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For colIndex = 2 To filePaths.Count
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(filePaths(colIndex))
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, finalPage, False)
Debug.Print "(" & colIndex & ") PAGES INSERTED SUCCESSFULLY: " & OK
sourceDoc.Close
Set sourceDoc = Nothing
Next colIndex
OK = primaryDoc.Save(PDSaveFull, filePaths(1))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub
附加代码:
我们在这里添加了更多内容。我不确定您对文件长度的处理方式,我有一种感觉,您打算将它们与要追加的页数链接起来。在这里,我们创建了两个集合,一个集合具有我们正在使用的文件的路径,另一个集合具有每个文件的页面数
Option Explicit
Sub AppendPDF()
Dim app As Object
Dim acroDoc As Object
Dim filePaths As Collection
Dim pgnumber As Range
Dim pageNum As Long
Dim FileNumPages As Collection
Dim pathwayIterator As Range
Dim primaryDoc As Object
Dim OK As String
Dim numPages As Long
Dim colIndex As Long
Dim sourceDoc As Object
Const finalPage = 2
Set app = CreateObject("Acroexch.app")
Set acroDoc = New AcroPDDoc
Set filePaths = New Collection
'Counts # of pages in each pdf, loads to column D.
For Each pgnumber In Range("A2:A100")
If Not IsEmpty(pgnumber) Then
acroDoc.Open pgnumber
pageNum = acroDoc.GetNumPages
Cells(pgnumber.Row, 4) = pageNum
End If
acroDoc.Close
Next pgnumber
'Append to this file, ideally will be a front page to append to, commented out for now.
'FilePaths.Add "\path\name\here"
'Active or not feature in Column B, Specify Yes to include in combination, no to exclude
Set filePaths = New Collection
Set FileNumPages = New Collection
For Each pathwayIterator In Range("A2:A100")
If pathwayIterator.Value <> "" Then
filePaths.Add pathwayIterator.Value2
FileNumPages.Add Cells(pathwayIterator.Row, 4)
End If
Next pathwayIterator
'Combine files which are listed in Column A.
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(filePaths(1))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For colIndex = 2 To filePaths.Count
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(filePaths(colIndex))
Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, finalPage, False)
Debug.Print "(" & colIndex & ") PAGES INSERTED SUCCESSFULLY: " & OK
sourceDoc.Close
Set sourceDoc = Nothing
Next colIndex
OK = primaryDoc.Save(PDSaveFull, filePaths(1))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub