Page Breaks in Excel

F

Fred

I've viewed a number of threads regarding Excel's knack of ignoring
page breaks when "Fit to" is used and have seen the suggestions as to
how to overcome this, using Fit to 1 page wide leaving the tall
selection blank, then swapping back to Zoom to, leaving the % value
unchanged.

My question is how would I achieve this in VB ? I've tried the trick
of recording the actions, but that always sets the .Zoom variable, is
there any way to find what the .Zoom is and then use that value in the
page definition ?

Thanks in advance
Fred Newton
 
J

JNW

The following will display the zoom value.

Sub displayZoom()
Dim numZoom As Variant
numZoom = ActiveSheet.PageSetup.Zoom
MsgBox numZoom
End Sub

You would just need something like the following to reset the zoom
percentage later.
activesheet.pagesetup.zoom = numzoom
 
F

Fred

Hmmm, sort of, well, no, not really. Because the macro (attached
below) first sets printing to 1 page wide and Zoom to False, when it
then goes to find what Zoom is it get a result of False.

Regards
Fred

Sub SetPageBreak()

SetPageOneWide

SetPageToPercent

End Sub

Sub SetPageOneWide()

Range("A1").Select
'
' Clear all existing Page Breaks
'
Worksheets("Proposal-2").ResetAllPageBreaks
'
' Set page layout to 1 page Wide by however many are needed Tall
'
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$12"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&F"
.CenterFooter = ""
.RightFooter = "&D / &T"
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.31496062992126)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.118110236220472)
.FooterMargin = Application.InchesToPoints(0.118110236220472)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
End Sub

Sub SetPageToPercent()
'
' Trap the Zoom % figure
'
numZoom = ActiveSheet.PageSetup.Zoom
'
' Set page layout to the saved % figure to force 1 page wide but then
allow insert of page breaks
'
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$12"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&F"
.CenterFooter = ""
.RightFooter = "&D / &T"
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.31496062992126)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.118110236220472)
.FooterMargin = Application.InchesToPoints(0.118110236220472)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = numZoom
End With
'
' Go back to the top of the worksheet
'
Range("A1").Select
'
' Find the 2nd occurrence of "Completion date"
'
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
'
' Go to column A
'
Range("A80").Select
'
' Insert Horizontal pagebreak
'
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell

End Sub
 
F

Fred

Sorry, my reply dropped a piece of text :

Hmmm, sort of, well, no, not really. Because the macro (attached
below) first sets printing to 1 page wide and Zoom to False, when it
then goes to find what Zoom is it get a result of False. When this is
done manually, the Zoom % figure is set to what it would need to be to
print one page wide, this is what I need to trap.

Cheers
Fred
 
J

JNW

Fred-

You shouldn't need both sub routines. I've combined them into one. I have
not tested it, but it should work.

This is all you should need.

Sub SetPrintArea()
'
' Trap the Zoom % figure
'
numZoom = ActiveSheet.PageSetup.Zoom
'
' Set page layout to the saved % figure to force 1 page wide but then allow
insert of page breaks
'
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$12"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&F"
.CenterFooter = ""
.RightFooter = "&D / &T"
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.31496062992126)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.118110236220472)
.FooterMargin = Application.InchesToPoints(0.118110236220472)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.FitToPagesWide = 1
.FitToPagesTall = False
.Zoom = numZoom
End With
'
' Go back to the top of the worksheet
'
Range("A1").Select
'
' Find the 2nd occurrence of "Completion date"
'
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
'
' Go to column A
'
Range("A80").Select
'
' Insert Horizontal pagebreak
'
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell

End Sub
 
F

Fred

Again a case of yes, but no, not really.

The macro creates a new spreadsheet to contain the report, the default
setting for page layout at this point is Zoom to 100%. Once all the
cells have been populated with data, using the above code finds Zoom
set at 100% (the default), then proceeds to set to landscape but at
100% rather than the actual page width (say 73%).

When I do the process manually Excel opens a new spreadsheet (default
Zoom factor is 100%), populate all the cells and then go to Page Setup,
change from Zoom to Fit To 1 page wide and OK. Excel, somehow,
updates the Zoom value at this point with the Zoom factor to achieve
the 1 page wide requirement, so that I can then go back into Page Setup
and change from Fit To back to Zoom and it will have the correct Zoom
factor for fitting to 1 page wide. The VB coding does not seem able to
pick this up and I think that unless there is somewhere else to pick up
the Zoom figure from (while Fit To is active) it will always come up
with the result of False because it has been told to "Fit To" so Zoom
will be false, if you see what I mean.

I suppose my question now is "When Fit To is active, is there somewhere
that I can pick up the Zoom factor from without getting an answer of
False because Fit To is active"

Regards and thanks for all your help
Fred
 
F

Fred

Again, yes, but no, not really.

The macro creates a new spreadsheet to contain the report, the default
setting for page layout at this point is Zoom to 100%. Once all the
cells have been populated with data, if I use the above code it finds
Zoom set at 100% (the default), so when it then goes through the page
setup code, it sets Zoom to be 100% (because that is what it found)
and, even though the Wide/Tall settings are there, because Zoom is not
False, they are ignored.

When I do the process manually Excel opens a new spreadsheet (default
Zoom factor is 100%), I then populate all cells and then go to Page
Setup, change from "Zoom" to "Fit To 1 page wide" and then OK. Excel,
somehow, updates the Zoom value at this point with the Zoom factor to
achieve the 1 page wide requirement, so that I can then go back into
Page Setup and change from "Fit To" back to "Zoom" and it will have the
correct Zoom factor for fitting to 1 page wide. The VB coding does not
seem able to pick this up and I think that unless there is somewhere
else to pick up the Zoom figure from (while Fit To is active) it will
always come up with the result of False because it has been told to
"Fit To" so Zoom will be false, if you see what I mean.

I suppose my question now is "When Fit To is active, is there somewhere
that I can pick up the Zoom factor from that it is using to achieve the
"Fit To" without getting an answer of False because Fit To is active"

Regards and thanks for all your help
Fred
 
J

JNW

sorry about that. Still learning as I go.

I'm also not sure if what is below will work for what you are looking for.
I've used this approach in other workbooks, but i've never needed to set
specific page breaks. Instead of trying to trap the zoom value after setting
to one page wide, this macro counts the number of rows in the worksheet
(assuming all rows are filled) and uses this to set the fittopagestall.

Hopefully this will work for you, or give you a jump start.

Sub SetPrintArea()
Dim NumRowsPerPrintPage As Integer
Dim PrntArea As Range
Dim NumRowsInWs As Integer

Range("A1").Select
Worksheets("Proposal-2").ResetAllPageBreaks

NumRowsPerPrintPage = "20"
NumRowsInWs = Application.WorksheetFunction.RoundUp _
(Application.WorksheetFunction.CountA(Range("A:A")) / _
NumRowsPerPrintPage, 0)

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$12"
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.31496062992126)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.118110236220472)
.FooterMargin = Application.InchesToPoints(0.118110236220472)
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = NumRowsInWs
End With


'
' Go back to the top of the worksheet
'
Range("A1").Select
'
' Find the 2nd occurrence of "Completion date"
'
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
'
' Go to column A
'
Range("A80").Select
'
' Insert Horizontal pagebreak
'
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell

End Sub
 
F

Fred

Still no joy i'm afraid, the expression :
NumRowsInWs = Application.WorksheetFunction.RoundUp _
(Application.WorksheetFunction.CountA(Range("A:A")) / _
NumRowsPerPrintPage, 0)

gives a zero return, which gives PageSetup the screaming abdabs.

I'm using Excel/97 (just in case this is something introduced after
this version.

Thanks again for the suggestions.

Have a good weekend

Regards
Fred
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top