View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
TFriis TFriis is offline
external usenet poster
 
Posts: 22
Default 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