View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
John Smith[_8_] John Smith[_8_] is offline
external usenet poster
 
Posts: 10
Default creating frame and option buttons programmatically

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.CommandButto n.1")
With CmdButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With

Set CmdButton2 =
TempForm.designer.Controls.Add("forms.CommandButto n.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