linkedcell with togglebuttons problem

[TFriis]

I used to use checkboxes, but a coworker of mine told me about
togglebuttons - so I'm wondering how I change the following code to
work with togglebuttons instead of checkboxes:

_____________________________

Sub chkb()

Dim RngChckBox

Set RngChckBox = Range("A1")
ActiveSheet.CheckBoxes.Add(RngChckBox.Left, RngChckBox.Top,
RngChckBox.Width, RngChckBox.Height).Select
With Selection
.LinkedCell = "'Sheet2'!" & RngChckBox.Address
.Characters.Text = "Test"
.OnAction = "msg"
End With

End Sub

Sub msg()

MsgBox "Test works"

End Sub

_____________________________

I have due to a lot of searching found out how to create togglebuttons
like this:

_____________________________

Sub tgbtn()

Dim RngTgnBtn

Set RngLink = Range("F2")
Set RngTgnBtn = Range("E8:F9")
ActiveSheet.OLEObjects.Add("Forms.ToggleButton.1", , , , , , ,
RngTgnBtn.Left, RngTgnBtn.Top, RngTgnBtn.Width,
RngTgnBtn.Height).Select
'With Selection
'.LinkedCell = RngLink.Address
'.Characters.Text = "Test"
'.OnAction = "msg"
'End With

End Sub

_____________________________

But I have no idea how I change the linkedcell

Any help is appreciated!

 

[TFriis]

I found a way around the issue, but I still can't get the OnAction to
work - any ideas?

Sub test()

Dim i As Integer

For i = 1 To 6

If i Mod 2 = 0 Then
Range("A1").Cells(i, 1) = Rnd
Else: Range("A1").Cells(i, 1) = -1 * Rnd
End If

Call AddToggle(i)
Next i

End Sub

Sub AddToggle(i As Integer)

Dim RngTgBtn As Range
Dim Str As String

If Left(ActiveSheet.Cells(i, 1), 1) = "-" Then
Str = Left(ActiveSheet.Cells(i, 1), 5)
Else: Str = Left(ActiveSheet.Cells(i, 1), 4)
End If

Set RngTgBtn = Range("A1").Cells(4, 3 + i)
RngTgBtn.RowHeight = 16.5

With ActiveSheet
.OLEObjects.Add(ClassType:="Forms.ToggleButton.1").Select
With Selection
.Left = RngTgBtn.Left
.Top = RngTgBtn.Top
.Width = RngTgBtn.Width
.Height = RngTgBtn.Height
.Name = "myTglBtn" & i
End With
With Selection.Object
.Caption = Str
.Font.Size = 7
.Font.Bold = True
.Value = True
End With
.Shapes("myTglBtn" & i).OLEFormat.Object.LinkedCell = "'" &
ActiveSheet.Name & "'!" & Range("A1").Cells(1, 3 + i).Address
'.Shapes("myTglBtn" & i).OLEFormat.Object.OnAction =
ThisWorkbook.Name & "!" & "Working.msg1"
'^^ line of code not working - any ideas?
End With

End Sub

Sub msg1()

MsgBox "Working", vbInformation

End Sub

 

[Jim Rech]

There is no OnAction property for Control Toolbox control. These controls
have preset 'action handlers' which consists of the name of the control and
the action, and they reside on the sheet's module.

Double-click a toggle button while in design mode to go to the change event
handler. Note there are quite a few events for a toggle button which you
can see by clicking the drop down in the upper right corner of the sheet1
module while the cursor is on the change event code.

--
Jim
|I found a way around the issue, but I still can't get the OnAction to
| work - any ideas?
|
| Sub test()
|
| Dim i As Integer
|
| For i = 1 To 6
|
| If i Mod 2 = 0 Then
| Range("A1").Cells(i, 1) = Rnd
| Else: Range("A1").Cells(i, 1) = -1 * Rnd
| End If
|
| Call AddToggle(i)
| Next i
|
| End Sub
|
| Sub AddToggle(i As Integer)
|
| Dim RngTgBtn As Range
| Dim Str As String
|
| If Left(ActiveSheet.Cells(i, 1), 1) = "-" Then
| Str = Left(ActiveSheet.Cells(i, 1), 5)
| Else: Str = Left(ActiveSheet.Cells(i, 1), 4)
| End If
|
| Set RngTgBtn = Range("A1").Cells(4, 3 + i)
| RngTgBtn.RowHeight = 16.5
|
| With ActiveSheet
| .OLEObjects.Add(ClassType:="Forms.ToggleButton.1").Select
| With Selection
| .Left = RngTgBtn.Left
| .Top = RngTgBtn.Top
| .Width = RngTgBtn.Width
| .Height = RngTgBtn.Height
| .Name = "myTglBtn" & i
| End With
| With Selection.Object
| .Caption = Str
| .Font.Size = 7
| .Font.Bold = True
| .Value = True
| End With
| .Shapes("myTglBtn" & i).OLEFormat.Object.LinkedCell = "'" &
| ActiveSheet.Name & "'!" & Range("A1").Cells(1, 3 + i).Address
| '.Shapes("myTglBtn" & i).OLEFormat.Object.OnAction =
| ThisWorkbook.Name & "!" & "Working.msg1"
| '^^ line of code not working - any ideas?
| End With
|
| End Sub
|
| Sub msg1()
|
| MsgBox "Working", vbInformation
|
| End Sub