The variables RangeToPrint and HeadingsAtTop are automatically calculated at the time the macro is run - so it works with spreadsheet worksheets of all sizes and shapes.
Here is the code:
Sub StandardReportLayout() ' ' StandardReportLayout Macro ' Autowidth Columns and color top header ' Dim x As Long, lastCell As Range, RangeToPrint As Range, HeadingsAtTop As Range x = ActiveSheet.UsedRange.Columns.Count Set lastCell = Cells.SpecialCells(xlCellTypeLastCell) Set HeadingsAtTop = Range(Cells(1, 1), Cells(1, x)) Set RangeToPrint = Range(Cells(1, 1), lastCell) ' HeadingsAtTop.Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent1 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorLight2 .TintAndShade = 0.799981688894314 .PatternTintAndShade = 0 End With Selection.Font.Bold = True ActiveWindow.LargeScroll ToRight:=0 Range("A1").Select Selection.End(xlToRight).Select Range(Selection, Cells(ActiveCell.Row, 1)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With RangeToPrint.Select Selection.Columns.AutoFit ActiveWindow.LargeScroll ToRight:=-1 Columns("A:A").Select Range(Selection, Selection.End(xlToRight)).Select Selection.Columns.AutoFit Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select ActiveSheet.PageSetup.PrintArea = RangeToPrint.Address Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With With ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With Application.PrintCommunication = True ActiveSheet.PageSetup.PrintArea = RangeToPrint.Address Application.PrintCommunication = False With ActiveSheet.PageSetup .LeftHeader = "&Z&F &A" .CenterHeader = "" .RightHeader = "" .LeftFooter = "Page &P of &N - &D &T" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) .TopMargin = Application.InchesToPoints(0.75) .BottomMargin = Application.InchesToPoints(0.75) .HeaderMargin = Application.InchesToPoints(0.3) .FooterMargin = Application.InchesToPoints(0.3) .PrintHeadings = False .PrintGridlines = True .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = False .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True End Sub
No comments:
Post a Comment