MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Togglebutton


Posted by MILAN on September 13, 2001 11:29 AM

I need some type of toggle or command button at the top of my .xlt template
that will add and remove (switch on/off) an autoshape or bullet to the top
left corner of the currently active cell.


Posted by Henry Root on September 13, 2001 5:00 PM


Not sure if either of these is what you want :-

1. To toggle between adding and removing a bullet in the active cell :-

Sub Toggle_Bullet()
Dim bullet As String
bullet = Chr(149) & Chr(32)
With ActiveCell
If Left(.Value, Len(bullet)) = bullet Then
.Value = Right(.Value, Len(.Value) - Len(bullet))
Else
.Value = bullet & .Value
End If
End With
End Sub


2. To toggle between adding/removing a drawing object in the active cell :-

Sub Add_Remove_Shape()
If ActiveSheet.DrawingObjects.Count = 0 Then
With ActiveSheet.Shapes.AddShape(msoShapeOval, 64.5, 32.25, 72#, 72#)
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Width = ActiveCell.Width
.Height = ActiveCell.Height
End With
Else
ActiveSheet.DrawingObjects.Cut
End If
End Sub

Posted by Milan on September 14, 2001 1:31 PM

So far my progress has been minimal. I used no. 2 but it only deletes all the objects on my sheet including the command button.
I assumen you can't use ActiveCell

Posted by Henry Root on September 14, 2001 6:16 PM

Try this :-

Sub Add_Remove_Shape()
On Error GoTo addShape
ActiveSheet.Shapes("My Shape").Cut
Exit Sub
addShape:
With ActiveSheet.Shapes.addShape(msoShapeOval, 64.5, 32.25, 72#, 72#)
.Name = "My Shape"
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Width = ActiveCell.Width
.Height = ActiveCell.Height
End With
On Error GoTo 0
End Sub


Posted by Henry Root on September 14, 2001 6:33 PM

Also try this :-


Also try this :-

Sub v()
Dim shp As Object, x As Integer
x = 0
For Each shp In ActiveSheet.DrawingObjects
If shp.Top = ActiveCell.Top And shp.Left = ActiveCell.Left Then
shp.Cut
x = x + 1
Exit For
End If
Next
If x = 0 Then
With ActiveSheet.Shapes.addShape(msoShapeOval, 64.5, 32.25, 72#, 72#)
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Width = ActiveCell.Width
.Height = ActiveCell.Height
End With
End If
End Sub


Posted by Milan on September 16, 2001 1:27 PM

Re: Also try this :-


#2 at least added a circle to the cell but hung up on shp.cut.

Should I use a toggle or a command button? Or maybe a userform for the user to reveiew each record than tag it somehow.
What is a good book to buy for VB?

Posted by Henry Root on September 16, 2001 4:03 PM

Re: Also try this :-


I've tested the macro and it works.
What it does is :-
1. If there is no shape on the worksheet where the top and left of the shape do not line up exactly with the top and left of the active cell, an oval shape is added to the active cell that fits exactly the size of the cell.
If you need some other shape, use the macro recorder to find out the code and then substitute the appropriate code in the macro.
2. If there is a shape where the top and left of the shape do line up exactly with the top and left of the active cell, the shape is deleted.

You can attach the macro to :
- a toggle button from the control toolbox toolbar
- a command button from the control toolbox toolbar.
- a command button from the forms toolbar
.......whatever you prefer.

You said "for the user to reveiew each record than tag it somehow."
What exactly is it that you are trying to do?
Your original question was how to toggle between adding and removing a shape in the active cell.

Have a look at the books recommended by Mr. Excel on this web site (http://www.mrexcel.com/book.shtml)

Posted by Milan on September 16, 2001 7:48 PM

Re: Also try this :-

Private Sub CommandButton1_Click()
Dim shp As Object, x As Integer
x = 0
For Each shp In ActiveSheet.DrawingObjects
If shp.Top = ActiveCell.Top And shp.Left = ActiveCell.Left Then
shp.Cut
x = x + 1
Exit For
End If
Next
If x = 0 Then
With ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, 135.75, 112.5, 7.5, 7.5)
.Fill.ForeColor.SchemeColor = 8
.Fill.Visible = msoTrue
.Fill.Solid
.Flip msoFlipVertical
.Top = ActiveCell.Top
.Left = ActiveCell.Left
End With
End If
End Sub

This worked, Thank You very much.
It takes 5 seconds to add the shape and the same to remove it. Should I expect it to be any faster?

I need to restrict this to a certain range of cells. Can you help with this also?

Again Thank You.

Posted by Henry Root on September 17, 2001 2:50 AM

Re: Also try this :-

Unfortunately, if you have a lot of shapes on the worksheet, the procedure takes a long time to loop through each shape.
There are persons with better brains than I that are stumped on how to do it more efficiently - have a look at
http://www.mrexcel.com/book.shtml
and all the follow-ups to that posting.

When you say "I want to restrict this to a certain range of cells", I presume you mean that if the active cell is not in the "certain range", then the macro will not run. If so, add this code at the start of the macro :-

Dim certainRange As Range
Set certainRange = Range("A1:A2", "B3") 'Change cell refs as required
If Intersect(certainRange, ActiveCell) Is Nothing Then Exit Sub


Posted by MILAN on September 18, 2001 11:41 AM

Re: Also try this :-

Thanks the above worked on the range issue.
What does Dim stand for?

Problem: This does not work on a protected sheet.


Posted by Henry Root on September 18, 2001 5:37 PM

Re: Also try this :-


Dim stands for "dimension" and is used to declare a variable.

To get the macro to work on a protected sheet, you could unprotect and re-protect with code in the macro :-
'at the beginning of the macro
ActiveSheet.Unprotect password:="whatever"
'at the end of the macro
ActiveSheet.Protect password:="whatever"

Also, you might want to password protect your code :-
In the VB Editor (Alt+F11) go to Tools>VBAProject Properties>Protection>Lock Project For Viewing and enter a password. Then save the project, close it and reopen it for the password to take effect.

Posted by Milan on September 19, 2001 8:21 PM

Re: Also try this :-

Henry

It working pretty smooth now Thanks. I have submitted a new question today. Your help is much appreciated.