VBA Borders in Excel 2007

[Leo]

The code below is designed to put medium outline and thin inside borders on
each page of a mulitpage excel worksheet. It used the BeforePrint event to
do this. It worked in Excel 2003 but in 2007 on a 2 page worksheet when it
calls Sub MixedBorders the bottom medium border gets erased on the first
page. What do I need to change? Or is this a bug in 2007?

Option Explicit

Private Sub Workbook_BeforePrint(Cancel As Boolean)
FormatBeforePrint
End Sub

Public Sub FormatBeforePrint()
Dim startRow As Long
Dim endRow As Long
Dim startColumn As Integer
Dim endColumn As Integer
Dim hpb As HPageBreak

'set up the starting conditions
startRow = 2
startColumn = 1
endColumn = Range("A1").CurrentRegion.Columns.Count

Range("A1").Select
Selection.End(xlDown).Select
Range("A1").Select
For Each hpb In ActiveSheet.HPageBreaks
If hpb.Type = xlPageBreakManual Then hpb.Delete
Next hpb
For Each hpb In ActiveSheet.HPageBreaks
endRow = hpb.Location.Row - 1
MixedBorders Range(Cells(startRow, startColumn), Cells(endRow,
endColumn))
startRow = endRow + 1
Next
endRow = Range("A1").CurrentRegion.Rows.Count
MixedBorders Range(Cells(startRow, startColumn), Cells(endRow,
endColumn))
End Sub

Public Sub MixedBorders(ByRef rng As Range)
Dim edge As Integer

rng.Borders(xlDiagonalDown).LineStyle = xlNone
rng.Borders(xlDiagonalUp).LineStyle = xlNone
'It fails here on 2nd pass
For edge = xlEdgeLeft To xlEdgeRight
With rng.Borders(edge)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 0
End With
Next edge
If rng.Columns.Count > 1 Then
With rng.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 15
End With
End If
If rng.Rows.Count > 1 Then
With rng.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 15
End With
End If
End Sub

 

[Peter T]

Don't know why your bottom border is not applied with your 2 print pages,
but try this instead

Public Sub MixedBordersNEW(ByRef rng As Range, _
Optional bDelAllBdrs As Boolean)
Dim i As Long

' If rng is single row/col skip error doing xlInsideHoriz/Vertical
On Error Resume Next

If bDelAllBdrs Then
With rng.Parent.UsedRange.Borders
For i = 5 To 12
.Item(i).LineStyle = xlNone
Next
End With
End If

rng.BorderAround xlContinuous, xlMedium, , vbBlack

For i = xlInsideVertical To xlInsideHorizontal
With rng.Borders(i)
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(192, 192, 192) 'grey
End With
Next

End Sub

Sub Test()

MixedBordersNEW Range("B2:H10"), True '.CurrentRegion

End Sub


In Excel 2007 probably better not to use colorIndex (above also good for
2003)

In passing, no need to do all that select suff in your code as posted

Regards,
Peter T