使用VBA将工作表中的每个表导出到单个PDF中的单独页面上

时间:2017-07-10 23:56:07

标签: excel-vba vba excel

我可以创建一个宏来将每个表导出到他们自己的PDF中,但有没有办法将每个表放在单个PDF中的自己的页面上?

Range("B2:C5").Select
ActiveSheet.PageSetup.PrintArea = "$B$2:$B$5"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "C:\Users\Lenovo\Documents\Book1.pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    True
Range("B2:C6").Select

所有建议都表示赞赏。

2 个答案:

答案 0 :(得分:2)

设置每个工作表PageSetup后,然后导出工作簿。

Sub test()

    Dim WB As Workbook, Ws As Worksheet
    Dim myFn As String
    Set WB = ThisWorkbook
    For Each Ws In Worksheets
        Ws.PageSetup.PrintArea = "$B$2:$B$5"
    Next Ws
    myFn = WB.Path & "\" & "test.pdf"

    WB.ExportAsFixedFormat xlTypePDF, myFn
End Sub

答案 1 :(得分:1)

几年前我正在和PDF合并,把一些东西合并在一起,将我选择的任何PDF合并到一起。

这是我的代码的合并部分,您需要根据自己的需要进行调整:

Sub MergePDFs()
Dim a As Variant, i As Long, n As Long, ni As Long, p As String
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

MyPath = Range("G1").Text
DestFile = Range("G2").Text
MyFiles = Join(WorksheetFunction.Transpose(Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)), ",")

  If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
  a = Split(MyFiles, ",")
  ReDim PartDocs(0 To UBound(a))

  On Error GoTo exit_
  If Len(Dir(p & DestFile)) Then Kill p & DestFile
  For i = 0 To UBound(a)
    ' Check PDF file presence
    If Dir(p & Trim(a(i))) = "" Then
      MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
      Exit For
    End If
    ' Open PDF document
    Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
    PartDocs(i).Open p & Trim(a(i))
    If i Then
      ' Merge PDF to PartDocs(0) document
      ni = PartDocs(i).GetNumPages()
      If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
        MsgBox "Cannot insert pages of" & vbLf & p & a(i), vbExclamation, "Canceled"
      End If
      ' Calc the number of pages in the merged document
      n = n + ni
      ' Release the memory
      PartDocs(i).Close
      Set PartDocs(i) = Nothing
    Else
      ' Calc the number of pages in PartDocs(0) document
      n = PartDocs(0).GetNumPages()
    End If
  Next

  If i > UBound(a) Then
    ' Save the merged document to DestFile
    If Not PartDocs(0).Save(PDSaveFull, p & DestFile) Then
      MsgBox "Cannot save the resulting document" & vbLf & p & DestFile, vbExclamation, "Canceled"
    End If
  End If

exit_:

  ' Inform about error/success
  If Err Then
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number
  ElseIf i > UBound(a) Then
    MsgBox "The resulting file is created:" & vbLf & p & DestFile, vbInformation, "Done"
  End If

  ' Release the memory
  If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
  Set PartDocs(0) = Nothing

  ' Quit Acrobat application
  AcroApp.Exit
  Set AcroApp = Nothing

End Sub

从内存中我没有在我的合并工具中编写这个例程但是我不记得我在哪里得到它所以我不能归功于原始编码器。