使用Excel分页符创建多个PDF

Question

我有一个工作簿，它完全打破了我对分页（使用Subtotals）的看法，但很明显，所有这些都是一个PDF - 这意味着将其发送出去，我必须手动将其拆分并在100多名员工中重新保存每个人的名单。

如果电子表格中员工的每个单元格中都有唯一值，那么我是否有任何方法可以将它们分组为每个员工单独导出PDF格式？

所以基本上我的分页符当前正是我喜欢它们的方式 - 但是如果有来自B2：B61的60个单元格（所有已经订购/组合在一起）为员工说“John Smith”，那么这60行是一行PDF（在PDF中打破了当前布局的页面），然后如果B62：B87的下25个单元格为员工说“Jane Smith”，则使用当前的分页符等制作一个PDF。

这样的事情可能吗？也许使用VBA？

谢谢！

编辑：这是一个数据样本 - 我在Excel C中使用带有小计的Excel，这是如何在每个组的更改中获取我喜欢的分页符。我只是使用Print＆gt;＆gt;保存为PDF以制作我的PDF。一切都运作良好，除非分组中的每一个变化都在分组 - 我想以某种方式让Excel根据D列中的内容吐出单独的PDF。这是spreadsheet。 （尽管Dropbox似乎删除了当前的分页符，这只是每次C列发生变化时。）

Answer 1

在VBA中，您可以访问许多属性来管理分页符。

Range.PageBreak会返回或设置分页符，因此您可以根据员工数量以编程方式管理分页符。

Worksheet.HPageBreaks和Worksheet.VPageBreaks可让您访问水平和垂直分页符集合。

所以Worksheet.HPageBreaks.Count例如，会给你的工作表中的水平分页符数量。

Worksheet.HPageBreaks(1).Location.Row会为您提供第一个水平分页符的位置，同样Worksheet.VPageBreaks(1).Location.Column会为您提供第一个垂直分页符的位置。

这些工具加上一个.Find或两个应该允许您将要生成的范围描述为.pdf，并允许您完成所需的工作。

在OP评论后使用入门代码示例进行编辑

重新阅读你的帖子后，这个入门代码会根据你的原始Q生成两个.pdf文件。我将页面长度设置为50行 - 这对字体大小，纸张大小，边距等很敏感。你需要提供你自己的'outputPath'来保存你的文件。示例在单列数据上运行。

这是一个启动程序，所以不对此进行保证，并且请注意，当代码运行时，将删除所有手动分页符（.ResetAllPageBreaks）。

Option Base 1
Sub pdf()
Dim ws As Worksheet
Dim dArr() As String, outputPath As String, fileStem As String
Dim dCol As Long, stRow As Long, endRow As Long, pStRow As Long
Dim docCnt As Long, lnCnt As Long
Dim rwsPerPage As Integer, topM As Integer, botM As Integer
Dim empNme As String

Set ws = Sheets("Data")
dCol = 2    'col B
stRow = 2   'row 2

pStRow = stRow
rwsPerPage = 50
topM = 36   'default in points
botM = 36   'default in points
outputPath = "<yourpath>\"
fileStem = "Employee "

docCnt = 1
lnCnt = 0

    With ws
        'set essential page parameters
        With .PageSetup
            .Orientation = xlPortrait
            .TopMargin = topM
            .BottomMargin = botM
        End With
        .ResetAllPageBreaks

        'last data row
        endRow = .Cells(Rows.Count, dCol).End(xlUp).Row
        'first employee name
        empNme = .Cells(stRow, dCol)

            'for each data row
            For c = stRow To endRow
                lnCnt = lnCnt + 1

                    'at change of employee name
                    If Not .Cells(c, dCol).Value = empNme Then
                        'put doc range into array
                        ReDim Preserve dArr(docCnt)
                        dArr(docCnt) = .Range(.Cells(pStRow, dCol), .Cells(c - 1, dCol)).Address
                        docCnt = docCnt + 1
                        'reset startrow of new employee
                        pStRow = c
                        empNme = .Cells(c, dCol).Value
                        'add hpage break
                        .HPageBreaks.Add before:=.Cells(c, dCol)
                        lnCnt = 0
                    End If

                    'at page length
                    If lnCnt = rwsPerPage Then
                        'add hpage break
                        .HPageBreaks.Add before:=.Cells(lnCnt, dCol)
                        lnCnt = 0
                    End If
            Next c

            'last employee if appropriate to array
            If c - 1 > pStRow Then
                ReDim Preserve dArr(docCnt)
                dArr(docCnt) = .Range(.Cells(pStRow, dCol), .Cells(c, dCol)).Address
            End If

            'produce pdf files
            For d = 1 To UBound(dArr, 1)
                .Range(dArr(d)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    outputpat & fileStem & d & ".pdf", Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=True
            Next d

    End With

End Sub 

使用OP数据编辑入门代码示例并修正outputPath中的拼写错误的编辑＃2

Option Base 1
Sub pdf()
Dim ws As Worksheet
Dim dArr() As String, outputPath As String, fileStem As String
Dim dCol As Long, stRow As Long, endRow As Long, pStRow As Long
Dim docCnt As Long, lnCnt As Long
Dim rwsPerPage As Integer, topM As Integer, botM As Integer
Dim empNme As String

Set ws = Sheets("Data")
dCol = 4    'col D
stRow = 2   'row 2

pStRow = stRow
rwsPerPage = 50
topM = 36   'default in points
botM = 36   'default in points
outputPath = "<yourpath>\"
fileStem = "Employee "

docCnt = 1
lnCnt = 0

    With ws
        'set essential page parameters
        With .PageSetup
            .Orientation = xlPortrait
            .TopMargin = topM
            .BottomMargin = botM
        End With
        .ResetAllPageBreaks

        'last data row
        endRow = .Cells(Rows.Count, dCol).End(xlUp).Row
        'first employee name
        empNme = .Cells(stRow, dCol)

            'for each data row
            For c = stRow To endRow
                lnCnt = lnCnt + 1

                    'at change of employee name
                    If Not .Cells(c, dCol).Value = empNme Then
                        'put doc range into array
                        ReDim Preserve dArr(docCnt)
                        dArr(docCnt) = .Range(.Cells(pStRow, dCol - 3), .Cells(c - 1, dCol - 1)).Address
                        docCnt = docCnt + 1
                        'reset startrow of new employee
                        pStRow = c
                        empNme = .Cells(c, dCol).Value
                        'add hpage break
                        .HPageBreaks.Add before:=.Cells(c, dCol)
                        lnCnt = 0
                    End If

                    'at page length
                    If lnCnt = rwsPerPage Then
                        'add hpage break
                        .HPageBreaks.Add before:=.Cells(lnCnt, dCol)
                        lnCnt = 0
                    End If
            Next c

            'last employee if appropriate to array
            If c - 1 > pStRow Then
                ReDim Preserve dArr(docCnt)
                dArr(docCnt) = .Range(.Cells(pStRow, dCol - 3), .Cells(c - 1, dCol - 1)).Address
            End If

            'produce pdf files
            For d = 1 To UBound(dArr, 1)
                .Range(dArr(d)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    outputPath & fileStem & d & ".pdf", Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=True
            Next d

    End With

End Sub