Draw line around page margins

[Mr_Mod]

Hi All,

I have a workbook that has a number of worksheets within it, each sheet has data in columns A to J. What i would like to do is when i print the workbook each of the pages has a thin line where the page margins are located.

Each of the sheets have a differing number of rows.

Is it possible in VBA to check for the first row that has text and the last row, then when i hit print draws a thin line around where the page margins have been set to be. I guess that i need to set the margins somewhere in mm at the beginning of the code, as well as centering the text on the page somehow.

I have looked here and googled and can find nothing on exactly what i am trying to do.

Any help appreciated.

[Hightree]

Hi All,

I have a workbook that has a number of worksheets within it, each sheet has data in columns A to J. What i would like to do is when i print the workbook each of the pages has a thin line where the page margins are located.

Each of the sheets have a differing number of rows.

Is it possible in VBA to check for the first row that has text and the last row, then when i hit print draws a thin line around where the page margins have been set to be. I guess that i need to set the margins somewhere in mm at the beginning of the code, as well as centering the text on the page somehow.

I have looked here and googled and can find nothing on exactly what i am trying to do.

Any help appreciated.

[Hightree]

Hello,

Example: make a line at the bottum.

Make a named range from the data area, example: RangeOut

With Worksheets("Sheet1").Range(RangeOut)
.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With

In this way you also can make the other border lines

HighTree

Greatings from the Netherlands

[Paul_Hossler]

Specific requirements are a little fuzzy so if this needs tweaking, let me know

It's a little tricky to know where the page breaks are since it depends on the selected printer, fonts, etc.

This assumes there is a default printer and that the pages are 1 wide

Option Explicit

Sub PageBox()
    Dim rBox As Range
    Dim aBreaks() As Long
    Dim i As Long, iLast As Long
    
    ActiveWindow.View = xlPageBreakPreview
    
    With ActiveSheet
        iLast = .UsedRange.Rows.Count
        ReDim Preserve aBreaks(1 To 1)
        aBreaks(1) = 1
        For i = 1 To iLast
            If .Rows(i).PageBreak = xlPageBreakAutomatic Then
                ReDim Preserve aBreaks(1 To UBound(aBreaks) + 1)
                aBreaks(UBound(aBreaks)) = i
            End If
        Next i
        
        If .Rows(iLast).PageBreak <> xlPageBreakAutomatic Then
            ReDim Preserve aBreaks(1 To UBound(aBreaks) + 1)
            aBreaks(UBound(aBreaks)) = iLast + 1
        End If
    
        With .Cells
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
        End With
    
        For i = LBound(aBreaks) To UBound(aBreaks) - 1
            Set rBox = Intersect(Range(.Rows(aBreaks(i)), .Rows(aBreaks(i + 1) - 1)), .UsedRange)
            
            With rBox
'                msgbox .Address
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
            End With
    
    
    
        Next i
    
    End With
End Sub

[Mr_Mod]

Paul,

Thanks for this, I have given it a try and it would need a bit of tweaking around page breaks. I get the line at the top of each page, but not at the bottom of each the pages except for the last page

Lets assume that each page would be A4 size, and would use adobe writer as the default printer

[Paul_Hossler]

Try this

It's a little simpler, and the .Borders did not always work the way I expected ( the xlInsideHorizontal lines was the main fix)

Option Explicit

Sub PageBox()
    Dim i As Long, iLast As Long
    
    ActiveWindow.View = xlPageBreakPreview
    
    With ActiveSheet
        iLast = .UsedRange.Rows.Count
        
        With .UsedRange
            With .Cells
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlNone
                .Borders(xlEdgeBottom).LineStyle = xlNone
                .Borders(xlEdgeRight).LineStyle = xlNone
            End With
            
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End With
        
        For i = 2 To iLast
            If .Rows(i).PageBreak = xlPageBreakAutomatic Then
                With .UsedRange.Rows(i - 1).Resize(2).Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
            End If
        Next i
    End With
End Sub

[Paul_Hossler]

The first version above assumed that the output was only one page wide.

This version should handle any number of pages wide

Option Explicit
Sub PageBox()
    Dim i As Long, iLast As Long
    
    ActiveWindow.View = xlPageBreakPreview
    
    With ActiveSheet
        With .UsedRange
            With .Cells
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlNone
                .Borders(xlEdgeBottom).LineStyle = xlNone
                .Borders(xlEdgeRight).LineStyle = xlNone
            End With
            
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End With
        
        For i = 2 To .UsedRange.Rows.Count
            If .Rows(i).PageBreak = xlPageBreakAutomatic Then
                With .UsedRange.Rows(i - 1).Resize(2).Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
            End If
        Next i
        
        For i = 2 To .UsedRange.Columns.Count
            If .Columns(i).PageBreak = xlPageBreakAutomatic Then
                With .UsedRange.Columns(i - 1).Resize(, 2).Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
            End If
        Next i
    
    End With
End Sub