linkedcell with togglebuttons problem
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
|