CODEWITHSUNDEEP
excelpdfvba
Ryan
Ryan

Reputation: 531

Using Excel Page Breaks to Create Multiple PDFs

I have a workbook that's broken up exactly how I'd like with regards to page breaks (from using Subtotals), but obviously that all goes into one PDF -- which means to send it out, I'd have to manually split it up and re-save each person's lists amongst 100+ employees.

Is there any way that I can group them to export as an individual PDF per employee, if there's a unique value in each cell for the employee in the spreadsheet?

So basically my page breaks are currently exactly how I'd like them -- but if there's 60 cells (all already ordered/grouped together) from B2:B61 that say "John Smith" for employee, make those 60 rows one PDF (page broken within that PDF how it's currently laid out), then if the next 25 cells from B62:B87 say "Jane Smith" for employee, make that one PDF with its current page breaks, etc.

Is something like this possible? Maybe using VBA?

Thanks!

EDIT: Here's a sample of data -- I'm using Excel with subtotals in Column C, which is how to get the page breaks where I'd like them at the change in each group. I just use Print >> Save to PDF to make my PDF. Everything works well, except while the page breaks are at every change in Group -- I'd like to somehow have Excel spit out separate PDFs based on what's in Column D. Here's the spreadsheet. (Even though Dropbox seemingly removes the current page breaks, which is just every time there's a change in Column C.)

Upvotes: 0

Views: 4292

Answers (1)

barryleajo
barryleajo

Reputation: 1952

Within VBA you have access to a number of properties to manage page breaks.

Range.PageBreak returns or sets a page break, so you could manage your page breaks programatically with respect to your employee counts.

Worksheet.HPageBreaks and Worksheet.VPageBreaks give you access to the horizontal and vertical page breaks collection.

So Worksheet.HPageBreaks.Count for example, will give yuo the number of horizontal page breaks in your worksheet.

Worksheet.HPageBreaks(1).Location.Row will give you the position of the first horizontal page break and similarly Worksheet.VPageBreaks(1).Location.Column will give you the location of the first vertical page break.

These tools coupled with a .Find or two should allow you to describe the range(s) to be produced as .pdf and allow you to accomplish what you require.

EDIT with starter code sample following OP comment

Having re-read your post this starter code produces two .pdf files based on your original Q. I have set page length to be 50 lines - this is sensitive to font size, paper size, margins etc. You need to provide your own 'outputPath' to save your files. Example runs on a single column of data.

It's a starter so no warranties with this, and be aware that when the code runs, all manual page breaks will be removed (.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

EDIT #2 with starter code sample using OP data and correcting a typo in the 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

Upvotes: 2

Related Questions