Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Page Break Automation
I tried Gord D.'s "clunker".
Couldn't get it to work, even with help from the group. Then I found the following, apparently originally from Frank Kabel. Works great, EXCEPT, it also puts a page break under the header. Can someone tell me how to get the following to ignore header rows. If I can specify (within the module), the number of header rows, this macro would be very versatile. (for many people) Just specify how many header rows there are, and which column is to be searched...... and Bob's your uncle. Sub AAAInsertBreak() ' AAAInsertBreak Macro ' Insert Page Break after each change of ' Data in Column B ' From Frank Kabel, Germany ' I added the following reset ActiveSheet.ResetAllPageBreaks Dim lastrow As Long Dim row_index As Long 'All the "B"'s were "A"'s, originally lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row For row_index = lastrow - 1 To 1 Step -1 If Cells(row_index, "B").Value < _ Cells(row_index + 1, "B").Value Then ActiveSheet.HPageBreaks.Add Befo= _ Cells(row_index + 1, "B") End If Next 'I added the Message Box MsgBox "COMPLETE!" End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Page Break Automation
BEEJAY,
I've cooked s'thing. Not thoroughly tested, but give it a try. It will look at TitleRows in PageSetup instead of your proposed setting of a header variable. it will not put a break before a blank, but keep blanks with previous page. it will not stop on cells containing errors like NA#. it will compare cells caseInsensitive, change vbTextCompare to vbBinaryCompare if you want) let me know :) Sub InsertPageBreakOnDataChange() Const sCOL As String = "B" Dim wks As Worksheet Dim pgs As PageSetup Dim rngD As Range Dim rngH As Range Dim r As Long Set wks = ActiveSheet Set pgs = wks.PageSetup wks.ResetAllPageBreaks wks.DisplayPageBreaks = False wks.DisplayAutomaticPageBreaks = False Application.ScreenUpdating = False If pgs.PrintArea = vbNullString Then Set rngD = wks.UsedRange Else Set rngD = wks.Range(pgs.PrintArea) End If If pgs.PrintTitleRows < vbNullString Then Set rngH = wks.Range(pgs.PrintTitleRows) If rngD.Row < rngH.Row Then MsgBox _ "PrintTitles must be above or toprows of PrintArea" Exit Sub ElseIf Not Intersect(rngH, rngD) Is Nothing Then If rngD.Row + rngD.Rows.Count <= rngH.Row + _ rngH.Rows.Count Then MsgBox "PrintArea must be larger than PrintTitles" Exit Sub End If Set rngD = rngD.Resize( _ rngD.Rows.Count - rngH.Rows.Count).Offset( _ rngH.Rows.Count) End If End If If Not rngD Is Nothing Then Set rngD = Intersect(rngD.EntireRow, wks.Columns(sCOL)) End If If Not rngD Is Nothing Then On Error GoTo errH: With rngD For r = .Count To 1 Step -1 With .Cells(r) If r 1 And Not IsEmpty(.Value) Then If StrComp(CStr(.Value), CStr(.Offset(-1).Value), _ vbTextCompare) Then wks.HPageBreaks.Add rngD(r) End If End If End With Next End With End If endH: wks.DisplayPageBreaks = True Application.ScreenUpdating = True Exit Sub errH: MsgBox Err.Description, _ vbExclamation + vbMsgBoxHelpButton, "Oops!" GoTo endH End Sub -- keepITcool | www.XLsupport.com | keepITcool chello nl | amsterdam BEEJAY wrote : I tried Gord D.'s "clunker". Couldn't get it to work, even with help from the group. Then I found the following, apparently originally from Frank Kabel. Works great, EXCEPT, it also puts a page break under the header. Can someone tell me how to get the following to ignore header rows. If I can specify (within the module), the number of header rows, this macro would be very versatile. (for many people) Just specify how many header rows there are, and which column is to be searched...... and Bob's your uncle. Sub AAAInsertBreak() ' AAAInsertBreak Macro ' Insert Page Break after each change of ' Data in Column B ' From Frank Kabel, Germany ' I added the following reset ActiveSheet.ResetAllPageBreaks Dim lastrow As Long Dim row_index As Long 'All the "B"'s were "A"'s, originally lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row For row_index = lastrow - 1 To 1 Step -1 If Cells(row_index, "B").Value < _ Cells(row_index + 1, "B").Value Then ActiveSheet.HPageBreaks.Add Befo= _ Cells(row_index + 1, "B") End If Next 'I added the Message Box MsgBox "COMPLETE!" End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Page Break Automation
Greetings:
Works great on my test sheet. Next step, try it on COPY of original sheet. Then, if all still OK, Study the code to learn from it. I must confess that a lot of it is beyond me, at this point. But I look forward to learning. Thanks much for your prompt response. "keepITcool" wrote: BEEJAY, I've cooked s'thing. Not thoroughly tested, but give it a try. It will look at TitleRows in PageSetup instead of your proposed setting of a header variable. it will not put a break before a blank, but keep blanks with previous page. it will not stop on cells containing errors like NA#. it will compare cells caseInsensitive, change vbTextCompare to vbBinaryCompare if you want) let me know :) Sub InsertPageBreakOnDataChange() Const sCOL As String = "B" Dim wks As Worksheet Dim pgs As PageSetup Dim rngD As Range Dim rngH As Range Dim r As Long Set wks = ActiveSheet Set pgs = wks.PageSetup wks.ResetAllPageBreaks wks.DisplayPageBreaks = False wks.DisplayAutomaticPageBreaks = False Application.ScreenUpdating = False If pgs.PrintArea = vbNullString Then Set rngD = wks.UsedRange Else Set rngD = wks.Range(pgs.PrintArea) End If If pgs.PrintTitleRows < vbNullString Then Set rngH = wks.Range(pgs.PrintTitleRows) If rngD.Row < rngH.Row Then MsgBox _ "PrintTitles must be above or toprows of PrintArea" Exit Sub ElseIf Not Intersect(rngH, rngD) Is Nothing Then If rngD.Row + rngD.Rows.Count <= rngH.Row + _ rngH.Rows.Count Then MsgBox "PrintArea must be larger than PrintTitles" Exit Sub End If Set rngD = rngD.Resize( _ rngD.Rows.Count - rngH.Rows.Count).Offset( _ rngH.Rows.Count) End If End If If Not rngD Is Nothing Then Set rngD = Intersect(rngD.EntireRow, wks.Columns(sCOL)) End If If Not rngD Is Nothing Then On Error GoTo errH: With rngD For r = .Count To 1 Step -1 With .Cells(r) If r 1 And Not IsEmpty(.Value) Then If StrComp(CStr(.Value), CStr(.Offset(-1).Value), _ vbTextCompare) Then wks.HPageBreaks.Add rngD(r) End If End If End With Next End With End If endH: wks.DisplayPageBreaks = True Application.ScreenUpdating = True Exit Sub errH: MsgBox Err.Description, _ vbExclamation + vbMsgBoxHelpButton, "Oops!" GoTo endH End Sub -- keepITcool | www.XLsupport.com | keepITcool chello nl | amsterdam BEEJAY wrote : I tried Gord D.'s "clunker". Couldn't get it to work, even with help from the group. Then I found the following, apparently originally from Frank Kabel. Works great, EXCEPT, it also puts a page break under the header. Can someone tell me how to get the following to ignore header rows. If I can specify (within the module), the number of header rows, this macro would be very versatile. (for many people) Just specify how many header rows there are, and which column is to be searched...... and Bob's your uncle. Sub AAAInsertBreak() ' AAAInsertBreak Macro ' Insert Page Break after each change of ' Data in Column B ' From Frank Kabel, Germany ' I added the following reset ActiveSheet.ResetAllPageBreaks Dim lastrow As Long Dim row_index As Long 'All the "B"'s were "A"'s, originally lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row For row_index = lastrow - 1 To 1 Step -1 If Cells(row_index, "B").Value < _ Cells(row_index + 1, "B").Value Then ActiveSheet.HPageBreaks.Add Befo= _ Cells(row_index + 1, "B") End If Next 'I added the Message Box MsgBox "COMPLETE!" End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel 2007 Page Break Adjustments causes a page break each cell | Excel Worksheet Functions | |||
How do I do page breaks when view menu doesnt page break preview | Excel Discussion (Misc queries) | |||
Remove big gray page number on Page Break Preview??? | Excel Discussion (Misc queries) | |||
change and/or remove page number watermark in page break preview | Excel Discussion (Misc queries) | |||
adding a new page break to an existing page break | Excel Discussion (Misc queries) |