Border Macros
I came across a bit of an annoyance. When i tried to put borders on a
protected sheet it would report an error. So, I added the following
code.
Sub borders()
Dim x As Variant
Dim wks As Worksheet
Set wks = ActiveSheet
x = ""
If wks.ProtectContents _
Or wks.ProtectDrawingObjects _
Or wks.ProtectScenarios Then
x = True
ActiveWorkbook.Unprotect
ActiveSheet.Unprotect
Else
End If
With Selection
.borders(xlDiagonalDown).LineStyle = xlNone
.borders(xlDiagonalUp).LineStyle = xlNone
With .borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
If .Columns.Count 1 Then
With .borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 48
End With
End If
If .Rows.Count 1 Then
With .borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 15
End With
End If
End With
If x = True Then
ActiveWorkbook.Protect
ActiveSheet.Protect
Else
End If
End Sub
|