Border Macros

[Santa-D]

I compiled a macro using the macro recorder to put borders around a
selection of cells.
However, I'm getting the following error when I do two cells.

Run-Time Error '1004': Unable to set the LineStyle property of the
Border class.

I know why this happens as well but not sure what to do to fix it.

Here is the VBA code for it:

Sub borders()
'
' borders Macro
' Macro recorded 24/08/2004 by Steven North
'
' Keyboard Shortcut: Ctrl+Shift+B
'
Selection.borders(xlDiagonalDown).LineStyle = xlNone
Selection.borders(xlDiagonalUp).LineStyle = xlNone
With Selection.borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 48
End With
With Selection.borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 15
End With
End Sub

Is it possible to do an If statement i.e.

IF ISERROR(With Selection.border(xlInsideVertical)) Then
NEXT WITH
ELSE
CONTINUE
END WITH ????

 

[Bob Phillips]

How perverse. This seems to work

Sub borders()

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
With .borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 15
End With
End With
End Sub




--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Santa-D]

Found a minor hiccup.

Two cells going up - works
Two cells going right - doesn't work.

Run-Time Error '1004' - Unable to set the linestyle property of the
Border Class.

The line that is highlighted is: .LineStyle = xlContinuous


The section it highlights is:

With .borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 15
End With
End With
End Sub


I tried changing the section from Count > 1 to Count < 1 and going up
two cells in one column which worked but going two cells to the right
didn't.

If .Columns.Count < 1 Then
With .borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 48
End With

Any ideas?

 

[Bob Phillips]

Your change doesn't make any sense at all. I concluded that, notwithstanding
what the macro recorder does, you cannot add an inside vertical on a single
column, hence the test for one than one before adding such. Maybe a similar
test on rows

Sub borders()

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
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Santa-D]

Thanks Bob, that worked a treat. I really appreciate your help, I've
been using that Macro for over four years and it really bugged me when
it came up with that error.

Your change doesn't make any sense at all.

That's because I stayed up late last night and watch the Italy -v-
Australia match in the World Cup last night. It is upsetting to see
Australia loose the way they did when they play very strong. However,
it's fantastic to see Australia get as far as they did. Go Socceroos!

 

[Santa-D]

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