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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.