Hi Guys
I am trying to get a few things together in the same macro, i have most of it but it's messy when i put it together and doesn't quite work.
My intention was to clear print area, have the first 2 rows printed in all sheets if more than 1, have a center foot with page No of, in landscape printed in greyscale.
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
With ws.PageSetup
.PrintArea = ""
.PrintTitleRows = "$1:$2"
.CenterFooter = "Page &P of &N"
.CenterVertically = False
.PrintHeadings = False
.Orientation = xlLandscape
.FirstPageNumber = xlAutomatic
.BlackAndWhite = True
End With
Next ws
Application.ScreenUpdating = True
Then set the print area based on the last cell with value,
Sub find_print_area()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
With ws.PageSetup.Activate
Dim x As Long, lastCell As Range
x = ActiveSheet.UsedRange.Columns.Count
Set lastCell = Cells.SpecialCells(xlCellTypeLastCell)
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), lastCell).Address
End Sub
End Sub
then to finish add a thick border around the "print area" area with a hairline border on the inside.
Sub Bordersup()
'
' Bordersup Macro
'
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
With ws.PageSetup.Activate
Range(Cells(1, 1), lastCell).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Range("J20").Select
End Sub
Any help will be really apreciated.
Regards
Jsantos
Bookmarks