Toggle button code to add shape and hide shape

W

woodportaj

New Member
Joined
Jan 22, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
I am trying to create a code for a toggle button. I want a circle to appear around the button when it is clicked, and I want the circle to be deleted or hidden when the button is clicked again. I'm VERY VERY new to this. I thought I had it but I keep getting an error. This is what I have so far.....

Private Sub ToggleButton1_Click()

If ToggleButton1.Value = True Then
'when the toggle button is not depressed
ActiveSheet.Shapes.AddShape(msoShapeOval, 3, 364.5, 90.75, 40.5).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
Selection.ShapeRange.Fill.Visible = msoFalse
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 2.25
End With
Selection.ShapeRange.ZOrder msoBringToFront
Else
'when the toggle button is depressed
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
If Not Application.Intersect(Sh.TopLeftCell, Range("C6:D7")) Is Nothing Then
Sh.Delete

End If


End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
Try this code. The toggle button can be placed anywhere on the sheet and the circle is centred over it with its radius is dependent on the size of the toggle button.
VBA Code: 
Private Sub ToggleButton1_Click()

    Dim x As Single, y As Single, r As Single
    Dim shCircle As Shape
    
    'Get x,y centre and radius for circle shape
    With ToggleButton1
        x = .Left + .Width / 2
        y = .Top + .Height / 2
        r = Sqr((.Width / 2) ^ 2 + (.Height / 2) ^ 2) 'hypotenuse of right-angled triangle
    End With
    
    'Find Circle
    Set shCircle = Nothing
    On Error Resume Next
    Set shCircle = ActiveSheet.Shapes("Circle")
    On Error GoTo 0
    
    If ToggleButton1.Value = True Then
        'when the toggle button is not depressed
        If shCircle Is Nothing Then
            'Circle doesn't exist so add new shape
            '                                .AddShape(type,left,top,width,height)
            Set shCircle = ActiveSheet.Shapes.AddShape(msoShapeOval, x - r, y - r, r * 2, r * 2)
            shCircle.Name = "Circle"
            With shCircle.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Weight = 2.25
                .Transparency = 0
            End With
            shCircle.Fill.Visible = msoFalse
            shCircle.ZOrder msoBringToFront
        Else
            'Position and show existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoTrue
            End With
        End If
    Else
        'when the toggle button is depressed
        If Not shCircle Is Nothing Then
            'Position and hide existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoFalse
            End With
        End If
    End If

End Sub
 
Upvote 0
John_w said:
Try this code. The toggle button can be placed anywhere on the sheet and the circle is centred over it with its radius is dependent on the size of the toggle button.
VBA Code: 
Private Sub ToggleButton1_Click()

    Dim x As Single, y As Single, r As Single
    Dim shCircle As Shape
   
    'Get x,y centre and radius for circle shape
    With ToggleButton1
        x = .Left + .Width / 2
        y = .Top + .Height / 2
        r = Sqr((.Width / 2) ^ 2 + (.Height / 2) ^ 2) 'hypotenuse of right-angled triangle
    End With
   
    'Find Circle
    Set shCircle = Nothing
    On Error Resume Next
    Set shCircle = ActiveSheet.Shapes("Circle")
    On Error GoTo 0
   
    If ToggleButton1.Value = True Then
        'when the toggle button is not depressed
        If shCircle Is Nothing Then
            'Circle doesn't exist so add new shape
            '                                .AddShape(type,left,top,width,height)
            Set shCircle = ActiveSheet.Shapes.AddShape(msoShapeOval, x - r, y - r, r * 2, r * 2)
            shCircle.Name = "Circle"
            With shCircle.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Weight = 2.25
                .Transparency = 0
            End With
            shCircle.Fill.Visible = msoFalse
            shCircle.ZOrder msoBringToFront
        Else
            'Position and show existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoTrue
            End With
        End If
    Else
        'when the toggle button is depressed
        If Not shCircle Is Nothing Then
            'Position and hide existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoFalse
            End With
        End If
    End If

End Sub
Click to expand...
PERFECT!!

I have multiple toggle boxes, how can I keep some of the boxes circled? Is that possible to have different functions for each toggle box? Like shown below

 

Attachments

  • Untitled.png
    Untitled.png
    47.4 KB · Views: 21
Upvote 0
The simplest way, without the complication of a class handler for multiple toggle buttons, is this:
VBA Code: 
Private Sub ToggleButton1_Click()
    TB_Click ToggleButton1
End Sub

Private Sub ToggleButton2_Click()
    TB_Click ToggleButton2
End Sub

Private Sub ToggleButton3_Click()
    TB_Click ToggleButton3
End Sub

Private Sub TB_Click(tb As ToggleButton)

    Dim x As Single, y As Single, r As Single
    Dim shCircle As Shape
    
    'Get x,y centre and radius for circle shape
    With tb
        x = .Left + .Width / 2
        y = .Top + .Height / 2
        r = Sqr((.Width / 2) ^ 2 + (.Height / 2) ^ 2) 'hypotenuse of right-angled triangle
    End With
    
    'Find Circle for this toggle button
    Set shCircle = Nothing
    On Error Resume Next
    Set shCircle = ActiveSheet.Shapes(tb.Name & "_Circle")
    On Error GoTo 0
    
    If tb.Value = True Then
        'when the toggle button is not depressed
        If shCircle Is Nothing Then
            'Circle doesn't exist so add new shape
            '                                .AddShape(type,left,top,width,height)
            Set shCircle = ActiveSheet.Shapes.AddShape(msoShapeOval, x - r, y - r, r * 2, r * 2)
            shCircle.Name = tb.Name & "_Circle"
            With shCircle.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Weight = 2.25
                .Transparency = 0
            End With
            shCircle.Fill.Visible = msoFalse
            shCircle.ZOrder msoBringToFront
        Else
            'Position and show existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoTrue
            End With
        End If
    Else
        'when the toggle button is depressed
        If Not shCircle Is Nothing Then
            'Position and hide existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoFalse
            End With
        End If
    End If

End Sub
Just add as many Private Sub ToggleButtonX_Click routines as you need.
 
Upvote 0
John_w said:
The simplest way, without the complication of a class handler for multiple toggle buttons, is this:
VBA Code: 
Private Sub ToggleButton1_Click()
    TB_Click ToggleButton1
End Sub

Private Sub ToggleButton2_Click()
    TB_Click ToggleButton2
End Sub

Private Sub ToggleButton3_Click()
    TB_Click ToggleButton3
End Sub

Private Sub TB_Click(tb As ToggleButton)

    Dim x As Single, y As Single, r As Single
    Dim shCircle As Shape
   
    'Get x,y centre and radius for circle shape
    With tb
        x = .Left + .Width / 2
        y = .Top + .Height / 2
        r = Sqr((.Width / 2) ^ 2 + (.Height / 2) ^ 2) 'hypotenuse of right-angled triangle
    End With
   
    'Find Circle for this toggle button
    Set shCircle = Nothing
    On Error Resume Next
    Set shCircle = ActiveSheet.Shapes(tb.Name & "_Circle")
    On Error GoTo 0
   
    If tb.Value = True Then
        'when the toggle button is not depressed
        If shCircle Is Nothing Then
            'Circle doesn't exist so add new shape
            '                                .AddShape(type,left,top,width,height)
            Set shCircle = ActiveSheet.Shapes.AddShape(msoShapeOval, x - r, y - r, r * 2, r * 2)
            shCircle.Name = tb.Name & "_Circle"
            With shCircle.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Weight = 2.25
                .Transparency = 0
            End With
            shCircle.Fill.Visible = msoFalse
            shCircle.ZOrder msoBringToFront
        Else
            'Position and show existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoTrue
            End With
        End If
    Else
        'when the toggle button is depressed
        If Not shCircle Is Nothing Then
            'Position and hide existing circle
            With shCircle
                .Left = x - r
                .Top = y - r
                .Width = r * 2
                .Height = r * 2
                .Visible = msoFalse
            End With
        End If
    End If

End Sub
Just add as many Private Sub ToggleButtonX_Click routines as you need.
Click to expand...
Thank You!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Object with VBA Code
Replies
8
Views
508
Micron
M
K
  • Question Question
Toggle Button to Start and Stop Macros
2
Replies
12
Views
3K
offthelip
O
Carlosjunior
  • Question Question
What I want , If I click on the toggle button must change color to vbgreen and if click it again change color to vbred for the code below, where and f
Replies
2
Views
730
Carlosjunior
Carlosjunior
J
  • Solved
Creating a VBA toggle button to show/hide multiple adjacent and non-adjacent columns in Excel
Replies
4
Views
1K
dmt32
D
D
  • Question Question
Toggle for Hiding or Unhiding a Few Specific or Named Rows
2
Replies
10
Views
3K
My Aswer Is This
My Aswer Is This

Forum statistics

Threads
1,223,958
Messages
6,175,627
Members
452,661
Latest member
Nonhle

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top