PDA

View Full Version : Draw line around page margins



Mr_Mod
04-13-2018, 09:52 PM
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
04-13-2018, 11:37 PM
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
04-13-2018, 11:43 PM
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
04-15-2018, 04:46 PM
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
04-15-2018, 06:32 PM
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
04-15-2018, 08:22 PM
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
04-16-2018, 12:12 PM
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