VBA: Dynamically Create Active X Frame and Yes / No Radio Button

[quicksandNAV]

Hello,

The following works correctly / as expected:

Form Controls / Group Box / Radio Button Method:

            ActiveSheet.GroupBoxes.Add(Range("B" & (ThisRow + 1)).Left, Range("B" & (ThisRow + 1)).Top, Range("B" & (ThisRow + 1)).Width, Range("B" & (ThisRow + 1)).Height).Select
            Selection.Characters.Text = ""
            ActiveSheet.OptionButtons.Add(Range("B" & (ThisRow + 1)).Left + 1, Range("B" & (ThisRow + 1)).Top + 1, 72, 10).Select
            Selection.Characters.Text = "No Issues Found"
            Selection.Value = True
            ActiveSheet.OptionButtons.Add(Range("B" & (ThisRow + 1)).Left + 1, Range("B" & (ThisRow + 1)).Top + 15, 72, 10).Select
            Selection.Characters.Text = "Issues Found"

I'll include the whole block of code at the bottom. Basically, I'm looking to convert the above section to using Active X Controls so that it will be possible to adjust the size of the radio button and the button text.

             ActiveSheet.OLEObjects.Add(ClassType:="Forms.Frame.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (ThisRow + 1)).Left, Top:=Range("B" & (ThisRow + 1)).Top, Width:=Range("B" & (ThisRow + 1)).Width, Height:=Range("B" & (ThisRow + 1)).Height).Select
             'Selection.Caption = ""

That does successfully create the frame, but the attempt to set the caption to empty fails (cannot reference that way). I've tried recording Macro to catch; no code is shown for updating the caption text (entirely possible I'm not doing something right to catch it). Assuming the frame caption can be removed, it'd be good to add two radio buttons to the frame, and set / adjust their properties (font / size, default one of them to already clicked, etc), similar to the group boxes method that works.

Here is the whole code body:

Public Sub Worksheet_Change(ByVal Target As Excel.Range)
    'If Intersect(Target, Range(INDIRECT("C5:C"&ROWS(C:C))) Is Nothing Then Exit Sub
    If Target.Column = 4 Then
        ThisRow = Target.Row
        If Target.Value <> "" Then
            ' We will be changing cells from an event, so disable events until done
            Application.EnableEvents = False
            
            ActiveSheet.Unprotect Password:="password"
            'Range("E" & ThisRow).Value = Now()
            Range("F" & ThisRow).Value = Format(Now, "mm-dd-yy")
            For Each cell In ActiveSheet.Range("A" & ThisRow & ":G" & ThisRow)
               cell.Locked = True
            Next cell
            
            ' Set default values for the next row
            'Range("A" & (ThisRow + 1)).Value = "N/A"
            'Range("B" & (ThisRow + 1)).CellControl.SetCheckbox
            
            ActiveSheet.GroupBoxes.Add(Range("B" & (ThisRow + 1)).Left, Range("B" & (ThisRow + 1)).Top, Range("B" & (ThisRow + 1)).Width, Range("B" & (ThisRow + 1)).Height).Select
            Selection.Characters.Text = ""
            ActiveSheet.OptionButtons.Add(Range("B" & (ThisRow + 1)).Left + 1, Range("B" & (ThisRow + 1)).Top + 1, 72, 10).Select
            Selection.Characters.Text = "No Issues Found"
            Selection.Value = True
            ActiveSheet.OptionButtons.Add(Range("B" & (ThisRow + 1)).Left + 1, Range("B" & (ThisRow + 1)).Top + 15, 72, 10).Select
            Selection.Characters.Text = "Issues Found"
            
            'With ActiveSheet.OLEObjects.Add(ClassType:="Forms.Frame.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (ThisRow + 1)).Left, Top:=Range("B" & (ThisRow + 1)).Top, Width:=Range("B" & (ThisRow + 1)).Width, Height:=Range("B" & (ThisRow + 1)).Height)
            '    Me.Caption = ""
            'End With
            
            Range("C" & (ThisRow + 1)).CellControl.SetCheckbox
            
            ' Re-protect the sheet
            ActiveSheet.Protect Password:="password"
            
            ' Re-enable events
            Application.EnableEvents = True
            
            'Save the sheet
            ThisWorkbook.Save
            
        End If
    End If
End Sub

 

[Micron]

I've found that in Access you cannot set certain things (e.g. form captions and IIRC, control labels) to a zls (zero length string). You can set them to one space though, which effectively makes them look blank. Try " " instead of "" ?

 

[Domenic]

Try the following...

Dim oleObj As OLEObject

Set oleObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Frame.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (ThisRow + 1)).Left, Top:=Range("B" & (ThisRow + 1)).Top, Width:=Range("B" & (ThisRow + 1)).Width, Height:=Range("B" & (ThisRow + 1)).Height)
            
oleObj.Object.Caption = ""

Hope this helps!

 

[quicksandNAV]

Thanks Domenic, seems that's a step closer. It seems the buttons are all part of the same 'group', rather than being pairs in separate groups. Guessing that's because the variables are being set in the same context? Can this be solved by moving this code block to another subroutine?

            Dim oleFrame As OLEObject
            Dim oleRadio1 As OLEObject
            Dim oleRadio2 As OLEObject
            
            Set oleFrame = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Frame.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (ThisRow + 1)).Left, Top:=Range("B" & (ThisRow + 1)).Top, Width:=Range("B" & (ThisRow + 1)).Width, Height:=Range("B" & (ThisRow + 1)).Height)
            oleFrame.Object.Caption = ""
            Set oleRadio1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (ThisRow + 1)).Left + 1, Top:=Range("B" & (ThisRow + 1)).Top + 1, Width:=72, Height:=10)
            oleRadio1.Object.Caption = "No Issues Found"
            Set oleRadio2 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (ThisRow + 1)).Left + 1, Top:=Range("B" & (ThisRow + 1)).Top + 15, Width:=72, Height:=10)
            oleRadio2.Object.Caption = "Issues Found"

 

[quicksandNAV]

Hmm, moving the code to subroutine didn't solve that issue:

Public Sub addRadio(row)

    Dim oleFrame As OLEObject
    Dim oleRadio1 As OLEObject
    Dim oleRadio2 As OLEObject
            
    Set oleFrame = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Frame.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (row + 1)).Left, Top:=Range("B" & (row + 1)).Top, Width:=Range("B" & (row + 1)).Width, Height:=Range("B" & (row + 1)).Height)
    oleFrame.Object.Caption = ""
    Set oleRadio1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (row + 1)).Left + 1, Top:=Range("B" & (row + 1)).Top + 1, Width:=72, Height:=10)
    oleRadio1.Object.Caption = "No Issues Found"
    Set oleRadio2 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, Left:=Range("B" & (row + 1)).Left + 1, Top:=Range("B" & (row + 1)).Top + 15, Width:=72, Height:=10)
    oleRadio2.Object.Caption = "Issues Found"

End Sub

 

[Micron]

You must be running it more than once to get that result. Not sure how, but you will need to specify the group name, otherwise they will all belong to the same group and that name will likely be the name of the sheet. Will have to play with that but I imagine someone will beat me to it.

 

[quicksandNAV]

Yup, the code runs every time a new row is added. Basically creating a new frame and adding buttons to it every row.

 

[Micron]

If you are doing this many more times than what's indicated, I might condense that into a loop with an integer variable. You can set the group name as in
oleRadio1.Object.GroupName = "group1"

and change the group name as you go. However, as written that will cause each button to be it's own group and that will allow multi selection. I think you need to pass a parameter to the sub that defines a new group name, or create a module level variable and increment that each time the sub is run. That may not work since if you close the wb and run the sub again, group id will start all over again. If you explain what triggers the code, maybe we can suggest a sub parameter that will work reliably.

EDIT - just had an idea - maybe use the row number as the group variable since you're likely changing that parameter every time you run it:
oleRadio1.Object.GroupName = "group" & row. I try not to use object names as variables though (row).

 

[Micron]

I think this is the answer to the problem:

Set oleRadio1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, _
Left:=Range("B" & (row + 1)).Left + 1, Top:=Range("B" & (row + 1)).Top + 1, Width:=72, Height:=20)
oleRadio1.Object.Caption = "No Issues Found"
oleRadio1.Object.GroupName = "group" & row

Set oleRadio2 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, _
Left:=Range("B" & (row + 1)).Left + 1, Top:=Range("B" & (row + 1)).Top + 15, Width:=72, Height:=20)
oleRadio2.Object.Caption = "Issues Found"
oleRadio2.Object.GroupName = "group" & row

 

[quicksandNAV]

Thanks Micron!

Interestingly, it seems the frame isn't associated with the button groups; I thought it would be necessary to set the group name on the frame, but it doesn't support that property. That doesn't impact the functionality, though; all the buttons are now acting as pairs, which is what was needed.