Excel VBA将一个范围内的多个图纸保存到一个PDF中

Question

我目前正在工作簿上，在工作表的A：A栏（“ STAM-Filialen”）中，几乎所有其他工作表的名称都在其中。我只希望在单个PDF中以column（“ A：A”）命名的工作表。我使用的代码使每个工作表都成为一个单独的文件。是否可以使用某种相同的代码将其另存为单个PDF？

Dim myCell As Range
Dim lastCell As Long
Dim PathName As String
lastCell = lastRow("STAM-Filialen")
PathName = Range("I10").Value

Worksheets("STAM-Filialen").Activate
For Each myCell In ThisWorkbook.Worksheets("STAM-Filialen").Range("A2:A" & lastCell).Cells
    Dim wksName As String
    wksName = myCell.Text
    ThisWorkbook.Worksheets(wksName).Range("A1:P60").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PathName & "DispoPlan.Filiaal " & wksName & ".PDF"
Next

Answer 1

我建议将所有值移动到一张纸上进行打印。然后在完成后删除此临时表。

下面是将每个工作表的每个范围并排放置在新工作表中的示例。

Option Explicit

Public Sub CreateSinglePDF()
    Dim ws As Range: Set ws = ThisWorkbook.Sheets(1).Range("A1:A4")
    Dim rangeDict As Object: Set rangeDict = CreateObject("Scripting.Dictionary")
    Dim cell As Range

    For Each cell In ws
        If Not rangeDict.exists(cell.Value) And cell.Value <> "" Then
            rangeDict.Add cell.Value, ThisWorkbook.Sheets(cell.Value).Range("A1:A5")
        End If
    Next

    Dim printsheet As Worksheet
    Set printsheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))

    Dim key As Variant
    Dim i As Long: i = 1
    For Each key In rangeDict
        printsheet.Range(printsheet.Cells(1, i), printsheet.Cells(5, i)).Value = rangeDict(key).Value
        i = i + 1
    Next

    printsheet.UsedRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\users\ryan\desktop\ExampleFile.pdf"
    printsheet.Delete
End Sub

Answer 2

要将多张工作表转换为一个pdf文档，

1. 首先选择多个工作表
2. 并使用Activesheet.ExportAsFixedFormat语句。
3. 可以在页面设置中设置页面的打印范围。

代码

   Sub test()
        Dim WB As Workbook
        Dim Ws As Worksheet
        Dim sht As Worksheet
        Dim PathName As String
        Dim vWs() as String '<~~ Variable change
        Dim rngDB As Range, rng As Range
        Dim n As Integer

        Set WB = ThisWorkbook
        Set Ws = WB.Worksheets("STAM-Filialen")

        PathName = Range("I10").Value

        With Ws
            Set rngDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
        End With

        For Each rng In rngDB
            n = n + 1
            ReDim Preserve vWs(1 To n)
            vWs(n) = rng.text '<~~ text
            Set sht = Sheets(rng.Value)
            With sht.PageSetup
                .PrintArea = "a1:p60"
            End With
        Next rng
        Sheets(vWs).Select '<~~ multiple sheets select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=PathName & "DispoPlan.Filiaal.PDF"

    End Sub

工作表（“ STAM-Filialen”）

已选择规格表

单个pdf