Togglebutton Macro

[sassriverrat]

Hello
Trying to figure out how to add a togglebutton via code. I've been adding buttons a few different ways, but the most efficient (to me) seemed this code that I've been using:

Sub Buttoner()

Dim a As Button
Dim w As WorkSheet

Set a = w.Buttons.Add(840, 170, 108, 30)
a.OnAction = "MyMacro"
a.Characters.text = "whatever I want"
End Sub

Lets me add a ton of buttons quickly.

Thanks

 

[mikerickson]

Have you considered check-boxes instead of toggle buttons? They function the same (On or Off).

 

[Jaafar Tribak]

There is no togglebutton in the Forms Controls.

You will need to use an ActiveX toggelbutton

 

[sassriverrat]

Unfortunately for this job it has to be a button (hide or show a series of cells) for the right appearance really. The workbook has to "look good" to be used by the least-computer friendly of people.....

I knew the activex togglebutton part, just wasn't sure if there was a simple change in my code or something very similar like "togglebuttons" in place of the buttons that I could put in, especially so it would allow me to generate a few buttons at the same time efficiently versus the tried and true method of just having excel "record" me adding them....

Thanks!

 

[mikerickson]

If you need buttons, you could use a command button from the Forms menn. If you attach it code like this, it will act like a toggle button (i.e. two states, and does something different when clicked in each state)

The caption could be make slicker, but this will give you the idea.

Sub Button1_Click()
    With ActiveSheet.Shapes(Application.Caller).TextFrame.Characters
        If .Text = "Hide" Then
            Rem code to hide cells
            .Text = "Show"
        Else
            Rem code to show cells
            .Text = "Hide"
        End If
    End With
End Sub

You can alter/toggle the font, italic and bold of the button's caption, but not the color of the face of the button.

 

[Jaafar Tribak]

edited ... will repost in a moment.

 

[Jaafar Tribak]

@sassriverrat,

If you don't want to use activeX Togglebuttons, you could make standard rectangular shapes look and behave like ones.

Workbook Demo


This is the signature of the function that adds the fake ToggleButtons :

Public Function CreateFakeToggleButton( _
ByVal Name As String, _
ByVal ParentSheet As Worksheet, _
ByVal Left As Single, _
ByVal Top As Single, _
ByVal Width As Single, _
ByVal Height As Single, _
ByVal Caption As String, _
ByVal OnActionMacro As String _
) As Shape


This is how the rectangular shapes looked on my screen after adjusting some formatting via appropriate code :




1- Code in a Standard Module: (Main)

Option Explicit

Option Private Module


Public Function CreateFakeToggleButton( _
        ByVal Name As String, _
        ByVal ParentSheet As Worksheet, _
        ByVal Left As Single, _
        ByVal Top As Single, _
        ByVal Width As Single, _
        ByVal Height As Single, _
        ByVal Caption As String, _
        ByVal OnActionMacro As String _
) As Shape

    Dim oShape As Shape

    Set oShape = ParentSheet.Shapes.AddShape(msoShapeRectangle, Left, Top, Width, Height)
    With oShape
        .Name = Name
        .AlternativeText = "Not-Pressed"
        .OnAction = OnActionMacro
        .Line.Visible = msoFalse
        With .Fill.ForeColor
            .ObjectThemeColor = msoThemeColorBackground1
            .Brightness = -0.05
        End With
        With .Shadow
            .Type = msoShadow25
            .Visible = msoTrue
            .Style = msoShadowStyleInnerShadow
            .Transparency = 0.5
            .OffsetX = 1.5
            .OffsetY = 1.31
        End With
        With .TextFrame2
            .TextRange.Text = Caption
            .TextRange.Font.Bold = msoTrue
            .TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
        End With
    End With
    
    Set CreateFakeToggleButton = oShape
    
End Function


Public Sub OnActionMacro()
    With ActiveSheet.Shapes(Application.Caller)
        If ToggleButtonValue(ActiveSheet.Shapes(Application.Caller)) Then
            MsgBox "(" & .Name & ")" & vbNewLine & vbNewLine & "Was Pressed."
        Else
            MsgBox "(" & .Name & ")" & vbNewLine & vbNewLine & "Was Not Pressed."
        End If
    End With
End Sub


Private Function ToggleButtonValue(ByVal Shp As Shape) As Boolean

    With Shp
        .Shadow.Type = msoShadow25
        .Shadow.Visible = msoTrue
        .Shadow.Style = msoShadowStyleInnerShadow
        .Shadow.Transparency = 0.5
        If .AlternativeText = "Not-Pressed" Then
            .AlternativeText = "Pressed"
            .Shadow.OffsetX = -1.5
            .Shadow.OffsetY = -1.31
        Else
            .AlternativeText = "Not-Pressed"
            .Shadow.OffsetX = 1.5
            .Shadow.OffsetY = 1.31
        End If
    End With
    
    Call Delay(0.1)

    ToggleButtonValue = IIf(Shp.AlternativeText = "Not-Pressed", True, False)

End Function


Private Sub Delay(ByVal HowLong As Single)
    Dim t As Single
    
    t = Timer
    Do
        DoEvents
    Loop Until Timer - t >= HowLong

End Sub

2- Code usage example:

Option Explicit

Sub Add_ToggleButtons_Test()
    Dim iRow As Integer, iCol As Integer, iCounter As Integer
    Dim sngWidth As Single, sngHeight As Single
    Dim oShp As Shape
    
    sngWidth = 100: sngHeight = 50
    For iRow = 1 To 3
        For iCol = 1 To 3
            iCounter = iCounter + 1
            Set oShp = CreateFakeToggleButton _
            ("ToggleButton " & iCounter, Sheet1, 2 * sngWidth * iCol, 2 * sngHeight * iRow, _
            sngWidth, sngHeight, "ToggleButton " & iCounter, "OnActionMacro")
            Debug.Print oShp.Name
        Next iCol
    Next iRow
End Sub

Sub Delete_ToggleButtons_Test()
    Dim oShp As Shape

    For Each oShp In Sheet1.Shapes
        If InStr(1, oShp.AlternativeText, "Pressed") Then
            oShp.Delete
        End If
    Next
End Sub

 

[mikerickson]

@Jaafar Tribak, Good thought, I forgot the imaging capabilities of rectangles.

 

[Jaafar Tribak]

@Jaafar Tribak, Good thought, I forgot the imaging capabilities of rectangles.

That's true mike ... Honestly, I never expected the results to be so fine-tuned when I first started playing with the Properties of the Shadow object to draw the shape's outlines and obtain the pressed\released toggle visual effect.