creating frame and option buttons programmatically

  • Thread starter Thread starter John Smith
  • Start date Start date
J

John Smith

Dear All,

I am trying to create userform on the fly. In my plan, I will create
two sets of option buttons in two frame, therefore, I can pick two
items from two list. But I really don't know how to put option buttons
in a frame diagrammatically. From code is modified from John
Walkenbach's code. But frame is drawn on top of buttons, therefore I
can not make any choice.

Can anyone help me?

Thanks






Option Explicit

Public ret1 As Variant

Sub GetOption(OpArray, Default, Title)
Dim TempForm As Object, Frame1, frame2 As MSForms.frame, OptButton
As MSForms.OptionButton, CmdButton1, CmdButton2 As
MSForms.CommandButton
Dim i, TopPos As Integer, MaxWidth As Long, Code As String

Application.VBE.MainWindow.Visible = False

Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800

Set Frame1 = TempForm.designer.Controls.Add("forms.frame.1")
With Frame1
.Caption = ""
.Height = 92
.Width = 50 + 6
.Left = 6
.Top = 2
End With

TopPos = 4
MaxWidth = 0
For i = LBound(OpArray) To UBound(OpArray)
Set OptButton =
TempForm.designer.Controls.Add("forms.OptionButton.1")
With OptButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .Value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i

Set CmdButton1 =
TempForm.designer.Controls.Add("forms.CommandButton.1")
With CmdButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With

Set CmdButton2 =
TempForm.designer.Controls.Add("forms.CommandButton.1")
With CmdButton2
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With

Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " ret1=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ret1 = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) = ""OptionButton"" Then" &
vbCrLf
Code = Code & " If ctl Then ret1 = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub"

With TempForm.codemodule
.insertlines .countoflines + 1, Code
End With

With TempForm
.Properties("Caption") = Title
.Properties("Width") = CmdButton1.Left + CmdButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
CmdButton1.Left = 106
CmdButton2.Left = 106
End If
.Properties("Height") = TopPos + 24
End With

VBA.UserForms.Add(TempForm.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
End Sub

Sub TestGetOption()
Dim Ops(1 To 6)
Dim i

On Error Resume Next
Dim X
Set X = ActiveWorkbook.VBProject
If Err <> 0 Then
MsgBox "Your security settings do not allow this macro to
run.", vbCritical
On Error GoTo 0
Exit Sub
End If

Ops(1) = "January"
Ops(2) = "Febuary"
Ops(3) = "March"
Ops(4) = "April"
Ops(5) = "May"
Ops(6) = "June"

Call GetOption(Ops, 1, "Select a month")
MsgBox Ops(ret1)
End Sub
 
Hi John
You shouldn't draw a frame after the buttons but move the frame to see your
buttons and drag and drop them on the frame.
now they should work and they will follow the frame so you can position it where
you want.
HTH
Cimjet
 
<FWIW>
You don't really need to put option buttons inside a frame. You can
assign each button as a member of a group via the GroupName property.
This will allow you to arrange your layout however you like and still
manage your option choices without the need for a 'container', thus
reducing the number of controls (and their associated overhead) on your
userform.
 
Back
Top