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
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