Excel Reports Setup using VBA Macros

warning: call_user_func_array() expects parameter 1 to be a valid callback, function 'zen_menu_item_link' not found or invalid function name in /hermes/bosnaweb22a/b2525/ipw.jfalkofske/public_html/maindrup/includes/theme.inc on line 669.

Similar to the prior blog post about standard footers in Word documents, I also created a VBA Macro for Excel which defines my print area, adds headers and footers to the printed pages, sets the first row to repeat on all pages, and add colors to the first row in the spreadsheet (titles).   It also sets the width of all the columns based on the width of the data within the column.

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

James Falkofske - TechnologyBites.blogspot.com