Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 50235

Print area and borders macro based on cells contents

$
0
0
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.

Code:

    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,

Code:

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.
Code:

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

Viewing all articles
Browse latest Browse all 50235

Trending Articles