Using Excel Page Breaks to Create Multiple PDFs -
Using Excel Page Breaks to Create Multiple PDFs -
i have workbook that's broken how i'd regards page breaks (from using subtotals), goes 1 pdf -- means send out, i'd have manually split , re-save each person's lists amongst 100+ employees.
is there way can grouping them export individual pdf per employee, if there's unique value in each cell employee in spreadsheet?
so page breaks how i'd them -- if there's 60 cells (all ordered/grouped together) b2:b61 "john smith" employee, create 60 rows 1 pdf (page broken within pdf how it's laid out), if next 25 cells b62:b87 "jane smith" employee, create 1 pdf current page breaks, etc.
is possible? maybe using vba?
thanks!
edit: here's sample of info -- i'm using excel subtotals in column c, how page breaks i'd them @ alter in each group. utilize print >> save pdf create pdf. works well, except while page breaks @ every alter in grouping -- i'd somehow have excel spit out separate pdfs based on what's in column d. here's spreadsheet. (even though dropbox seemingly removes current page breaks, every time there's alter in column c.)
within vba have access number of properties manage page breaks.
range.pagebreak returns or sets page break, manage page breaks programatically respect employee counts.
worksheet.hpagebreaks , worksheet.vpagebreaks give access horizontal , vertical page breaks collection.
so worksheet.hpagebreaks.count
example, give yuo number of horizontal page breaks in worksheet.
worksheet.hpagebreaks(1).location.row
give position of first horizontal page break , worksheet.vpagebreaks(1).location.column
give location of first vertical page break.
these tools coupled .find
or 2 should allow describe range(s) produced .pdf , allow accomplish require.
edit starter code sample next op comment
having re-read post starter code produces 2 .pdf files based on original q. have set page length 50 lines - sensitive font size, paper size, margins etc. need provide own 'outputpath' save files. illustration runs on single column of data.
it's starter no warranties this, , aware when code runs, manual page breaks removed (.resetallpagebreaks).
option base of operations 1 sub pdf() dim ws worksheet dim darr() string, outputpath string, filestem string dim dcol long, strow long, endrow long, pstrow long dim doccnt long, lncnt long dim rwsperpage integer, topm integer, botm integer dim empnme 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 ws 'set essential page parameters .pagesetup .orientation = xlportrait .topmargin = topm .bottommargin = botm end .resetallpagebreaks 'last info row endrow = .cells(rows.count, dcol).end(xlup).row 'first employee name empnme = .cells(strow, dcol) 'for each info row c = strow endrow lncnt = lncnt + 1 'at alter of employee name if not .cells(c, dcol).value = empnme 'put doc range 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 'add hpage break .hpagebreaks.add before:=.cells(lncnt, dcol) lncnt = 0 end if next c 'last employee if appropriate array if c - 1 > pstrow redim preserve darr(doccnt) darr(doccnt) = .range(.cells(pstrow, dcol), .cells(c, dcol)).address end if 'produce pdf files d = 1 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 end sub
edit #2 starter code sample using op info , correcting typo in outputpath
option base of operations 1 sub pdf() dim ws worksheet dim darr() string, outputpath string, filestem string dim dcol long, strow long, endrow long, pstrow long dim doccnt long, lncnt long dim rwsperpage integer, topm integer, botm integer dim empnme 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 ws 'set essential page parameters .pagesetup .orientation = xlportrait .topmargin = topm .bottommargin = botm end .resetallpagebreaks 'last info row endrow = .cells(rows.count, dcol).end(xlup).row 'first employee name empnme = .cells(strow, dcol) 'for each info row c = strow endrow lncnt = lncnt + 1 'at alter of employee name if not .cells(c, dcol).value = empnme 'put doc range 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 'add hpage break .hpagebreaks.add before:=.cells(lncnt, dcol) lncnt = 0 end if next c 'last employee if appropriate array if c - 1 > pstrow redim preserve darr(doccnt) darr(doccnt) = .range(.cells(pstrow, dcol - 3), .cells(c - 1, dcol - 1)).address end if 'produce pdf files d = 1 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 end sub
excel excel-vba pdf
Comments
Post a Comment