toggle borders

P

pwilson.bowdoin

I am trying to create a macro that toggles borders around a cell. If
the cell has no borders, then the macro will place a border on the
topedge. If there is a top border, then the macro will remove the top
border and add a border on the right edge. This is what I have and it
is not working and I'm not sure why. Thanks for the help!

Sub ToggleBorder()
With Selection
If .Borders(xlEdgeTop).LineStyle = xlNone _
And .Borders(xlEdgeRight).LineStyle = xlNone _
And .Borders(xlEdgeBottom).LineStyle = xlNone _
And .Borders(xlEdgeLeft).LineStyle = xlNone _
Then .Borders(xlEdgeTop).LineStyle = xlContinuous _
Else
If .Borders(xlEdgeTop).LineStyle = xlContinuous _
And .Borders(xlEdgeRight).LineStyle = xlNone _
And .Borders(xlEdgeBottom).LineStyle = xlNone _
And .Borders(xlEdgeLeft).LineStyle = xlNone _
Then .Borders(xlEdgeRight).LineStyle = xlContinuous _
And .Borders(xlEdgeTop).LineStyle = xlNone_
End With
End Sub
 
R

Rick Rothstein \(MVP - VB\)

I made the guess that you wanted to continue moving the border around the
cell all the way until it turned off again. Give this code a try an see if
it does what you want...

Sub ToggleBorder()
Dim Index As Long
Dim FoundIt As Boolean
With ActiveCell
For Index = 0 To 3
If .Borders(Choose(Index + 1, xlEdgeTop, xlEdgeRight, xlEdgeBottom, _
xlEdgeLeft)).LineStyle = xlContinuous Then
FoundIt = True
Exit For
End If
Next
If FoundIt Then
ActiveCell.Borders.LineStyle = xlNone
Index = Index + 1
If Index < 4 Then
.Borders(Choose(Index + 1, xlEdgeTop, xlEdgeRight, xlEdgeBottom, _
xlEdgeLeft)).LineStyle = xlContinuous
End If
Else
.Borders(xlEdgeTop).LineStyle = xlContinuous
End If
End With
End Sub

Rick
 
P

Peter T

You have a giant single line "If - Then - Else If - Then" with many clauses
which is masking the logic and encouraging some code, that whilst it works I
doubt does what you intend, eg
Then .Borders(xlEdgeRight).LineStyle = xlContinuous _
And .Borders(xlEdgeTop).LineStyle = xlNone_

That's the end of the single line, this bit in its entirety
= xlContinuous And .Borders(xlEdgeTop).LineStyle = xlNone
evaluates to 0 or 1 as the value to be applied to xlEdgeTop
I assume the 'And' should be replaced with a colon :

Try the following:

Sub ToggleBorders2()
With Selection.Borders
If .Item(xlEdgeTop).LineStyle = xlNone Then
.Item(xlEdgeTop).LineStyle = xlContinuous
.Item(xlEdgeRight).LineStyle = xlNone
Else
.Item(xlEdgeTop).LineStyle = xlNone
.Item(xlEdgeRight).LineStyle = xlContinuous
End If
End With
End Sub

Regards,
Peter T
 
P

Peter T

On reflection I made that more complicated than it need be, I think simply
this should be OK:

' code in a class named Class1
Option Explicit
Public WithEvents cht As Excel.Chart

Private Sub cht_Select(ByVal ElementID As Long, _
ByVal Arg1 As Long, ByVal Arg2 As Long)

If ElementID = xlSeries And Arg2 > 0 Then
If Arg1 = 1 Then
Range("Out")(Arg2) = Range("Main")(Arg2)
Range("Main")(Arg2).Clear
ElseIf Arg1 = 2 Then
Range("Main")(Arg2) = Range("Out")(Arg2)
Range("out")(Arg2).Clear
End If
' following optional
On Error Resume Next ' error if no value points
cht.SeriesCollection(Arg1).Select
On Error GoTo 0
End If

End Sub


and as before -

' code in a normal module
Dim clsChtEvents As Class1
Sub StartChartEvents()
Set clsChtEvents = New Class1

Set clsChtEvents.cht = ActiveSheet.ChartObjects(1).Chart

End Sub

Sub StopChartEvents()
Set clsChtEvents = Nothing
End Sub

Regards,
Peter T
 
P

Peter T

Not sure how I posted to the wrong thread.
FWIW it (below) was intended as a follow-up in subject:
"Workable Scatter Plot Data Points"
- a thread originally started about 5hrs before this one.

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top