Find rows where natural Excel page breaks occur 3

[EddyH]

Simple objective:I need to know the row numbers that are just below and just above the natural page breaks in a long Excel file of 1000 rows or so.

I am writing a macro to automate thjis and other bits involving text wrapping so VBA method needed. It must be locked away in help somewhere, I just can't seem to get it translated correctly to the macro. Just do me the first break is fine.
thanks

 

[TonyJollans]

Hi EddyH,

There might be easier ways but all I know is the PageBreak Property of Rows and Columns and the only way I know to find one is to check each row. This might not be ideal for you, but given a row it will return the first row on the next page (i.e. just after the next page break):

Sub Test()
    MsgBox NextPageFirstRow(1)
End Sub

Function NextPageFirstRow(lRow As Long) As Long

    NextPageFirstRow = lRow
    
    While Rows(NextPageFirstRow).PageBreak = xlNone
        NextPageFirstRow = NextPageFirstRow + 1
    Wend

End Function

Perhaps you can adapt it to your needs.

Enjoy,
Tony

------------------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading FAQ222-2244 before you ask a question.

 

[Nelviticus]

It depends on your paper size, and to a lesser extent on the printer you have selected. Assuming neither will change, just go to print preview in an empty worksheet then switch back to normal view and use the page border guides to find the last row manually. Put that in your code as a constant.

Depending on your needs this might be sufficient, and it's a damn sight easier than coding

Nelviticus

 

[TheBitDoctor]

EddyH:

Try this:

Sub Test1()
Dim X As HPageBreaks
Dim pb As HPageBreak

Set X = Worksheets(1).HPageBreaks
MsgBox "Page Break count: " & X.Count
'This is required to populate the HPageBreaks collection!?!?
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
For Each pb In X
If pb.Extent = xlPageBreakFull Then
Debug.Print pb.Location.Row, "Full Page Break"
Else
Debug.Print pb.Location.Row, "Partial Page Break"
End If
Next
End Sub

This was really a strange one. Shows just how quirky Excel can be. It turns out that Excel doesn't bother to define the page breaks until it absolutely has to. I tried a test run and Excel reported properly that the current sheet had 28 horizontal page breaks. I adjusted the height of several rows and the count changed properly. BUT, when I tried to access the members of the HPageBreaks collection I received an "Out of Range" error for anything past the first one. I couldn't figure out why a collection reported a count of 28 but gave an error when you tried to access anything past the first one. Until I happened to page down a few times and then check the object. Just one more reason why this is still more art than science!

Ron

 

[EddyH]

Appreciate all replies will be useful for other stuff too!
Got me on the right road
This code with a twiddle or two will capture what I want.
Also counts the pages!

PageCount=1
Do
If Not Rows(ActiveCell.Row).PageBreak = xlNone Then PageCount=PageCount+1
MsgBox ActiveCell.Row & " of page " & PageCount
end if
ActiveCell.Offset(1, 0).Select
Loop

As 1000's of rows to do and some will wrap others not, I need a programmatic page end finder. May also need to adjust font size and change row heights by a %age factor to fit, so as to avoid 31.1 pages if you know what I mean.

Thanks

 

[TheBitDoctor]

EddyH:

Looping through all the rows could take quite a while. Try the following code instead:


Public Enum ViewPointAction
SaveViewpoint = 1
RestoreViewpoint = 2
End Enum

Sub SelectRealLastCell()
Dim lRealLastRow As Long
Dim lRealLastColumn As Long
Range("A1&quot.Select
On Error Resume Next
lRealLastRow = Cells.Find("*", Range("A1&quot, xlFormulas, , xlByRows, xlPrevious).Row
lRealLastColumn = Cells.Find("*", Range("A1&quot, xlFormulas, , xlByColumns, xlPrevious).Column
Cells(lRealLastRow, lRealLastColumn).Select
End Sub

Sub ManageUserViewpoint(Action As ViewPointAction)
Static SaveCurSelection As String
Static SaveActiveCell As String
Static SaveCurViewRow As Long
Static SaveCurViewCol As Integer

If Action = RestoreViewpoint Then
ActiveSheet.Range(SaveCurSelection).Select
ActiveSheet.Range(SaveActiveCell).Activate
ActiveWindow.ActivePane.ScrollRow = SaveCurViewRow
ActiveWindow.ActivePane.ScrollColumn = SaveCurViewCol
Else
SaveCurSelection = Selection.Address
SaveActiveCell = ActiveCell.Address
SaveCurViewRow = ActiveWindow.ActivePane.ScrollRow
SaveCurViewCol = ActiveWindow.ActivePane.ScrollColumn
End If

End Sub

Function GetFinalPageRowCount() As Integer
Dim LastUsedRow As Long
Dim ScreenUpdatingFlag As Boolean
Dim FirstRowOfLastPage As Long

ScreenUpdatingFlag = Application.ScreenUpdating
Application.ScreenUpdating = False
ManageUserViewpoint (SaveViewpoint)

SelectRealLastCell
'You must not only select the last cell, you need to roll it onto the
' screen for Excel to populate the HPageBreaks collection !?!?
ActiveWindow.ActivePane.ScrollRow = Selection.Row
LastUsedRow = ActiveCell.Row
FirstRowOfLastPage = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count).Location.Row

ManageUserViewpoint (RestoreViewpoint)
Application.ScreenUpdating = ScreenUpdatingFlag

GetFinalPageRowCount = LastUsedRow - FirstRowOfLastPage + 1
End Function

Sub CheckIt()

MsgBox "There are " & GetFinalPageRowCount & _
" rows on the last page, Page " & ActiveSheet.HPageBreaks.Count + 1

End Sub

Test it out by calling CheckIt and then manipulating row height and margins then calling CheckIt again.

Hope you find this useful,
Ron

 

[EddyH]

Thanks Bit Doctor I will run thru it later to disentangle what it does. I'll eventually need something to rapido the process when I've put it together. Given Tony a star so far as he set me on the road, but don't get upset!

I now need to programmatically wrap the text but not to look as below

A344 A very lonely dog went walking along the line desperately seeking a tree

but as below with blanks instead of xxxxx

A345 Some other sort of animal was running away from the xxxxxrampant vision in the distance

I'll forgo more examples.

I cannot insert a column to fit the leading A344 nonsense but somehow need to program the fascist ALT+RETURN character at the correct location in the string followed by spaces 5.

Better clarify now, this text will be lengthy medical procedure names in reality.

Any ideas?

 

[PHV]

To insert a ALT+RETURN character in a cell, use something like this:
ActiveCell.FormulaR1C1 = "1st line" & Chr(10) & "2nd line"
You may have to play with the Len,InStr and Mid VBA functions.

Hope This Help
PH.

 

[PHV]

Have you tried this ?
[A345].Value="Some other sort of animal was running away from the" _
& vbLf & " rampant vision in the distance"

Hope This Help
PH.

 

[SkipVought]

FYI

Not a VBA solution but handy

View/Page Break Mode

and...

faq707-4390 How to find TOTAL NUMBER OF PRINT PAGES in VBA



Skip,

http://www.TheOfficeExperts.com

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[TheBitDoctor]

EddyH:

I've always found Tony's tips to be on the mark and very helpful so I've nothing to be upset about over his star. But, &quot;disentangle&quot;, now that hurts! :-<

To walk you through it:

If you make a call to GetFinalPageCounts (See updated code below),
first the function turns off screen updating to keep the user from seeing the screen jumps, then it stores the users current viewpoint so we can put them back where they were when the function was called.
Next, the function jumps to the last used printable cell and scrolls it onto the active window pane so the HPageBreaks and VPageBreaks objects will be fully populated.
Now the function can capture the items of interest, the final row and column to be printed and the first row and column of the final page.

Finally, the function returns the screen to where the user was when we started and it computes and returns the number of rows and columns that will be printed on the final page.

After you make the call to this function the HPageBreaks and VPageBreaks objects will have been populated so you can get the row numbers at each of the page breaks (Your original question) by looping through the collection with:

For Each pb In Activesheet.HPageBreaks
Debug.Print pb.Location.Row
Next

Skip's FAQ points out that my original code only works when your dealing with a printout that is one page wide by multiple pages long. The code below incorporates Skip’s function and is updated to handle columns as well as rows.

SKIP: **NOTE** There is an error on your FAQ. You need to add one to the HPageBreak.Count as well as the VPageBreak.Count since a page break always occurs between two pages.

If you place a button on a toolbar and assign it to the Check_It subroutine then you can play with the Row Height, Column Width, Rows at Top of each page, and The Columns at the left of each page, and check the results of your changes easily.

Just remember that each row's height can be independantly manipulated so trying to determine how to adjust row heights to preclude having a small number of rows on the last page is not a straight forward calculation.

Hope this has helped to &quot;disentangle&quot; my code.
Good Luck with your project,
Ron

=============== Updated Code ====================
Public Enum ViewPointAction
SaveViewpoint = 1
RestoreViewpoint = 2
End Enum

Public Type CellsPrinted
RowCount As Integer
ColumnCount As Integer
End Type


Function TotalPrintPagesOnWorksheet() As Integer
With ActiveSheet
TotalPrintPagesOnWorksheet = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
End With
End Function

Sub SelectRealLastCell()
Dim lRealLastRow As Long
Dim lRealLastColumn As Long
Range(&quot;A1&quot.Select
On Error Resume Next
lRealLastRow = Cells.Find(&quot;*&quot;, Range(&quot;A1&quot, xlFormulas, , xlByRows, xlPrevious).Row
lRealLastColumn = Cells.Find(&quot;*&quot;, Range(&quot;A1&quot, xlFormulas, , xlByColumns, xlPrevious).Column
Cells(lRealLastRow, lRealLastColumn).Select
End Sub

Sub ManageUserViewpoint(Action As ViewPointAction)
Static SaveCurSelection As String
Static SaveActiveCell As String
Static SaveCurViewRow As Long
Static SaveCurViewCol As Integer

If Action = RestoreViewpoint Then
ActiveSheet.Range(SaveCurSelection).Select
ActiveSheet.Range(SaveActiveCell).Activate
ActiveWindow.ActivePane.ScrollRow = SaveCurViewRow
ActiveWindow.ActivePane.ScrollColumn = SaveCurViewCol
Else
SaveCurSelection = Selection.Address
SaveActiveCell = ActiveCell.Address
SaveCurViewRow = ActiveWindow.ActivePane.ScrollRow
SaveCurViewCol = ActiveWindow.ActivePane.ScrollColumn
End If

End Sub

Function GetFinalPageCounts() As CellsPrinted
Dim LastUsedRow As Long
Dim LastUsedColumn As Long
Dim ScreenUpdatingFlag As Boolean
Dim FirstRowOfLastPage As Long
Dim FirstColumnOfLastPage As Long

ScreenUpdatingFlag = Application.ScreenUpdating
Application.ScreenUpdating = False
ManageUserViewpoint (SaveViewpoint)

SelectRealLastCell
'You must not only select the last cell, you need to roll it onto the
' screen for Excel to populate the HPageBreaks and VPageBreaks collections !?!?
ActiveWindow.ActivePane.ScrollRow = Selection.Row
ActiveWindow.ActivePane.ScrollColumn = Selection.Column
LastUsedRow = ActiveCell.Row
LastUsedColumn = ActiveCell.Column
FirstRowOfLastPage = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count).Location.Row
FirstColumnOfLastPage = ActiveSheet.VPageBreaks(ActiveSheet.VPageBreaks.Count).Location.Column

ManageUserViewpoint (RestoreViewpoint)
Application.ScreenUpdating = ScreenUpdatingFlag

GetFinalPageCounts.RowCount = LastUsedRow - FirstRowOfLastPage + 1
GetFinalPageCounts.ColumnCount = LastUsedColumn - FirstColumnOfLastPage + 1
End Function

Sub CheckIt()
Dim FinalPageCounters As CellsPrinted
Dim Index As Integer
Dim Message As String

FinalPageCounters = GetFinalPageCounts
MsgBox &quot;There are &quot; & vbCr & FinalPageCounters.RowCount & _
&quot; rows and &quot; & vbCr & FinalPageCounters.ColumnCount & &quot; columns &quot; & _
vbCr & &quot;on the last page, Page &quot; & TotalPrintPagesOnWorksheet

Message = &quot;Page starting rows are as follows: &quot; & vbCr & vbCr
Index = 1
If ActiveSheet.PageSetup.Order = xlOverThenDown Then
For Each pb In ActiveSheet.HPageBreaks
Index = Index + ActiveSheet.VPageBreaks.Count + 1
Message = Message & &quot;Page &quot; & Index & &quot; Begins with row: &quot; & pb.Location.Row & vbCr
Next
Else
For Each pb In ActiveSheet.HPageBreaks
Index = Index + 1
Message = Message & &quot;Page &quot; & Index & &quot; Begins with row: &quot; & pb.Location.Row & vbCr
Next
End If

MsgBox Message

End Sub

 

[TheBitDoctor]

EddyH:

I got so &quot;entangled&quot; with my own code I forgot about your second question. (By the way, you'll get better visibility if you post your questions on independent threads.)

Here's my code. PH was on the right track, the trick is to use the &quot;FormulaR1C1&quot; property or the carriage return just becomes another character in the cell. Also, to get the second text row to align properly with the first you'll need to use a non-proportional font like Courier.

Sub Macro1()
'
Dim MyCRTab
MyCRTab = Chr(10) & &quot; &quot;
'
ActiveCell.FormulaR1C1 = _
&quot;G888 The quick brown fox,&quot; & MyCRTab & &quot;Jumped over the lazy dog.&quot;
With ActiveCell.Characters.Font
.Name = &quot;Courier New&quot;
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End Sub


*UPDATE* ==> I just found a bug in my previous post. I'll leave it to you to change the code to handle the limiting case where there are no Horizontal and/or Vertical Page Breaks (HPageBreaks.Count and/or VPageBreaks.Count equal 0.)

Ron

 

[EddyH]

OK bitDoctor
I am an amateur at this stuff as you realise, on the lernin rather than burnin curve. Starred you as it looks like the answer lurks where you directed me.

I'll start a new thread for each bit in future, thanks for the hint. Glad I didn't get any responses from psychologists to analyse my rapping text examples!

I certainly get entangled writing VBA glad I'm not alone.