View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
JNW JNW is offline
external usenet poster
 
Posts: 480
Default Page Breaks in Excel

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 Befo=ActiveCell

End Sub

"Fred" wrote:

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 Befo=ActiveCell

End Sub