Option Explicit
Dim iWidth As Long, iTop As Long, iLeft As Long
Dim isTrue As Boolean
Private Sub UserForm_Initialize()
Dim i As Long
Call addFrames
Call addOptions
Call positionFrames
End Sub
Private Sub addFrames()
Dim sFrame As String
Dim ctrl As Object
Dim i As Long
iTop = 9
For i = 1 To 100
If Trim(Cells(i, 1)) <> vbNullString Then
If Trim(Cells(i, 1)) <> sFrame Then
sFrame = Trim(Cells(i, 1))
Call addControl(Me, "Frame", sFrame)
End If
End If
Next
End Sub
Private Sub addOptions()
'Dim sFrame As String
Dim ctrl As Object
Dim i As Long
Dim sControlType As String
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" Then
iTop = 7: iLeft = 3: sControlType = "OptionButton": isTrue = True
If ctrl.Tag = "Toppings" Then
sControlType = "CheckBox"
isTrue = False
ElseIf ctrl.Tag = "Cheese" Then
Call addControl(ctrl, sControlType, "No Cheese", "None")
End If
For i = 1 To 100
If Cells(i, 1) = ctrl.Tag Then
Call addControl(ctrl, sControlType, Cells(i, 2), CStr(i))
End If
Next
End If
Next
End Sub
Sub addControl(controlParent As Object, sControlType As String, sName As String, Optional sTag As String)
If controlParent Is Nothing Then Exit Sub
If sControlType = vbNullString Then Exit Sub
With controlParent.Controls.Add("Forms." & sControlType & ".1")
Select Case sControlType
Case "Frame"
.Top = iTop
.Left = iTop
.Width = Me.Width / 2 - 2 * iTop
.Height = Me.Height / 2 - 2 * iTop
.Tag = sName
.Caption = sName
iTop = iTop + 9
Case "OptionButton", "CheckBox":
.Caption = sName
.Top = iTop
.Left = iLeft
.WordWrap = False
.Width = Me.Width / 2
.AutoSize = True
If .Width > iWidth Then iWidth = Int(.Width - 0.0001) + 2
.Tag = sTag
.Value = isTrue
isTrue = False
iTop = iTop + Int(.Height - 0.0001) + 2
controlParent.Height = iTop + 7
controlParent.Width = iWidth + iLeft + 2
End Select
End With
End Sub
Private Sub positionFrames()
Dim ctrl As Object, ctrl1 As Object
Dim iTop As Long, iLeft As Long
' Code in here is specific. For usability purposes, we want to position each frame
' Breads top-left
' Meats below it; with both framewidths the same
' Cheese top, beside Breads
' Toppings below it; with both framewidths the same
' and tabindexes to match positioning
iWidth = 0
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Bread" Then _
ctrl.Top = 3: ctrl.Left = 3: iWidth = IIf(ctrl.Width > iWidth, ctrl.Width, iWidth)
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Meats" Then
For Each ctrl1 In Me.Controls
If TypeName(ctrl1) = "Frame" And ctrl1.Tag = "Bread" Then
ctrl.Left = ctrl1.Left
ctrl.Top = ctrl1.Top + ctrl1.Height + 2
iWidth = IIf(ctrl.Width > iWidth, ctrl.Width, iWidth)
ctrl.Width = iWidth
ctrl1.Width = iWidth
End If
Next
End If
Next
iWidth = 0
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Cheese" Then
For Each ctrl1 In Me.Controls
If TypeName(ctrl1) = "Frame" And ctrl1.Tag = "Bread" Then
ctrl.Left = ctrl1.Left + ctrl1.Width + 2
ctrl.Top = ctrl1.Top
iWidth = IIf(ctrl.Width > iWidth, ctrl.Width, iWidth)
End If
Next
End If
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Toppings" Then
For Each ctrl1 In Me.Controls
If TypeName(ctrl1) = "Frame" And ctrl1.Tag = "Cheese" Then
ctrl.Left = ctrl1.Left
ctrl.Top = ctrl1.Top + ctrl1.Height + 2
iWidth = IIf(ctrl.Width > iWidth, ctrl.Width, iWidth)
ctrl.Width = iWidth
ctrl1.Width = iWidth
End If
Next
End If
Next
' A bit of a cheat here. Setting the tabindex to zero forces everything else to be greater
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Toppings" Then ctrl.TabIndex = 0: Exit For
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Cheese" Then ctrl.TabIndex = 0: Exit For
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Meats" Then ctrl.TabIndex = 0: Exit For
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Frame" And ctrl.Tag = "Bread" Then ctrl.TabIndex = 0: Exit For
Next
End Sub