Page Breaks in Excel
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
|