Hi Gethsaine,
See the attached file which creates groups of Active X OptionButtons. The file does not use 'Linked Cells' but the following syntax in the Create Section should do the job for you. This particular file uses a class event handler.
TempControl.LinkedCell = "A39"
In your situation, I would name the OptionButtons and Groups in some kind of sequence (e.g. 'OptionButton00103 (3rd option button in first group) and 'Group001'. That way each item has a unique name. If you are inserting new rows, you would have to access all the OptionButtons on the Sheet to determine what the next sequential group number would be.
Lewis
---------------------------
Ordinary Module Code:
Option Explicit
'This code is based on code from Andy Pope (Thank you Andy)
'http://www.excelforum.com/excel-programming-vba-macros/1021112-call-userform-from-a-variable-number-of-activex-command-buttons.html
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The following line ENABLES or DISABLES 'MsgBox' output
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const bEnableMSGBOX As Boolean = True
Private Const myOptionButtonCOUNT As Long = 6
Private Const sControlTypeDESCRIPTION As String = "Active X OptionButton"
Private Const sControlTYPE As String = "OptionButton"
Public myOptionButtonEvents As Collection
Sub DisableEventsThenPopulateThenEnableEventsForOptionButtons()
'NOTE: All the routines seem to work fine independently.
' Some routines do not play well with others, when cascaded together.
' That is why the 'Delete' and 'Create' routines are not in this routine.
Call DisableOptionButtonEvents
Call PopulateOptionButtons
Call EnableOptionButtonEvents
End Sub
Sub CreateOptionButtons()
'This Creates 'Active X' Controls
Dim Output As Range
Dim TempControl As OLEObject
Dim iCount As Long
Dim iControlsInGroup As Long
Dim iIndex As Long
Dim sGroupName As String
Dim sCaption As String
'First Control will be at the 'Top Left' of the following cell
Set Output = ActiveSheet.Range("B4")
'Create two groups of option Button
iControlsInGroup = myOptionButtonCOUNT / 2
For iIndex = 1 To myOptionButtonCOUNT
'Create the Command Button
Set TempControl = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=Output.Left, _
Top:=Output.Top, _
Width:=Output.Width * 2, _
Height:=Output.Height * 2)
If iIndex <= iControlsInGroup Then
sCaption = "Group" & "A " & iIndex
sGroupName = "GroupA"
Else
sCaption = "Group" & "B " & (iIndex - iControlsInGroup)
sGroupName = "GroupB"
End If
TempControl.Object.Caption = sCaption
TempControl.Object.GroupName = sGroupName
Debug.Print "'''''''''''''''''''''''''''"
Debug.Print TempControl.Top
Debug.Print TempControl.Name
Debug.Print TempControl.Object.Caption
Debug.Print TempControl.Object.GroupName
'Increment the 'Top Left' for the next OptionButton
Set Output = Output.Offset(3, 0)
'Increment the Control Created Count
iCount = iCount + 1
Next
If bEnableMSGBOX = True Then
MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control(s) were Created."
End If
'Clear object pointer
Set TempControl = Nothing
End Sub
Sub IterateThruOptionButtons()
'This iterates through 'Active X' Controls in Immediate Window (CTRL G)
Dim myObject As OLEObject
Dim iCount As Long
For Each myObject In ActiveSheet.OLEObjects
If TypeName(myObject.Object) = "OptionButton" Then
iCount = iCount + 1
Debug.Print Format(iCount, "000 ") & _
Format(myObject.Name, "!@@@@@@@@@@@@@@@@@@ ") & _
Format(myObject.Object.Caption, "!@@@@@@@@@@@@ ") & _
Format(myObject.Object.GroupName, "!@@@@@@@ ") & _
Format(myObject.Object.Value, "!@@@@@@@ ") & _
Format(myObject.Top, "@@@@@@@ ") & _
Format(myObject.Left, "@@@@@@@ ") & _
Format(myObject.Width, "@@@@@@@ ") & _
Format(myObject.Height, "@@@@@@@ ")
End If
Next myObject
If iCount = 0 Then
Debug.Print "There were NO" & Format(sControlTypeDESCRIPTION, " @") & " CONTROLS to Iterate through."
End If
End Sub
Sub EnableOptionButtonEvents()
'This Enables Active X Events (Active X controls must already exist)
Dim OptnButtonEvents As ClassOptionButtonEvent
Dim myObject As OLEObject
Dim iCount As Long
Dim iIndex As Long
'Define the Event Collection
Set myOptionButtonEvents = New Collection
'Create the Events
For Each myObject In ActiveSheet.OLEObjects
iIndex = iIndex + 1
If TypeName(myObject.Object) = sControlTYPE Then
Set OptnButtonEvents = New ClassOptionButtonEvent
Set OptnButtonEvents.myOptionButton = ActiveSheet.OLEObjects(iIndex).Object
myOptionButtonEvents.Add OptnButtonEvents, CStr(myOptionButtonEvents.Count + 1)
iCount = iCount + 1
If iCount >= myOptionButtonCOUNT Then
Exit For
End If
End If
Next myObject
If bEnableMSGBOX = True Then
MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control Event(s) were Enabled."
End If
End Sub
Sub DisableOptionButtonEvents()
'This Disables Active X Events
Dim iCount As Long
Dim iStartingControlEventCount As Long
'Test to see if Controls Exist
On Error Resume Next
iStartingControlEventCount = myOptionButtonEvents.Count
On Error GoTo 0
'Disable Controls
If iStartingControlEventCount > 0 Then
Do While myOptionButtonEvents.Count > 0
myOptionButtonEvents.Remove 1
iCount = iCount + 1
Loop
End If
If bEnableMSGBOX = True Then
MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control Event(s) were Disabled."
End If
'Clear object pointer
Set myOptionButtonEvents = Nothing
End Sub
Sub DeleteOptionButtons()
'This deletes 'Active X' Controls
Dim myObject As OLEObject
Dim iCount As Long
For Each myObject In ActiveSheet.OLEObjects
If TypeName(myObject.Object) = sControlTYPE Then
iCount = iCount + 1
myObject.Delete
End If
Next myObject
If bEnableMSGBOX = True Then
MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control(s) were Deleted."
End If
End Sub
Class Module Code (Must be in Class Module Named 'ClassOptionButtonEvent'):
Option Explicit
'This code is based on code from Andy Pope (Thank you Andy)
'http://www.excelforum.com/excel-programming-vba-macros/1021112-call-userform-from-a-variable-number-of-activex-command-buttons.html
Public WithEvents myOptionButton As MSForms.OptionButton
Private Sub myOptionButton_Click()
'This is the Active X Event Handler
MsgBox "Clicked " & Me.myOptionButton.Name & " - " & Me.myOptionButton.Caption & " - " & Me.myOptionButton.Value
End Sub
Bookmarks