使用Excel分页符创build多个PDF

我有一个工作簿已经打破了我想如何分页（从使用小计），但很明显，所有进入一个PDF – 这意味着发送出去，我不得不手动分裂它并重新将每个人的名单保存在100多名员工中。

如果电子表格中的员工在每个单元格中存在唯一的值，是否有任何方法可以将他们分组，以每个员工的个人PDF格式导出？

所以，基本上我的分页符正好是我想要的 – 但是如果从B2：B61中有60个单元格（全部已经订购/分组在一起）中为员工说明了“John Smith”，那么将这60行放在一个PDF页面那么如果从B62：B87的下一个25个单元格为员工说出“Jane Smith”，则使用当前分页符打开一个PDF文件。

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

谢谢！

编辑：这里是一个数据的样本 – 我在C列中使用Excel的小计，这是如何获得分页，我想他们在每个组中的变化。 我只是使用打印>>保存到PDF来使我的PDF。 一切都运行良好，除了分页符在组中的每一个变化 – 我想以某种方式Excel根据列D中的内容吐出单独的PDF。这里是电子表格 。 （即使Dropbox似乎删除了当前的分页符，这只是每次C列发生变化）

Answer 1

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

Range.PageBreak返回或设置一个分页符，所以你可以pipe理你的分页符关于你的员工数量编程。

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

因此， Worksheet.HPageBreaks.Count例如，将给你的工作表中水平分页符的数量。

Worksheet.HPageBreaks(1).Location.Row将给你的第一个水平分页Worksheet.HPageBreaks(1).Location.Row的位置和类似的Worksheet.VPageBreaks(1).Location.Column将给你的第一个垂直分页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数据编辑2号入门代码示例，并更正outputPath中的拼写错误

 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