SOLVED. I've tweaked Kyles code so that the form does what I want it to.
Below is a generic version for anyone who needs this code.
Form Code:
Option Explicit
'multiplier needs fine tuning
Private Const msngcWidthMultiplier As Single = 4.31 '7.8
'margins for buttons. these are fine. do not change!
Private Const mbytcMarginW As Byte = 5
Private Const mbytcMarginH As Byte = 7
Private Const mbytcButtonH As Byte = 24
'name of sub to close form
Private Const mstrcSubCloseForm As String = "CloseTempForm"
Private Sub UserForm_Activate()
With Me
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With
End Sub
Private Sub UserForm_QueryClose(ByRef Cancel As Integer, ByRef CloseMode As Integer)
Set oColl = Nothing
Application.Run mstrcSubCloseForm
'If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
Public Sub SetButtonsFromArrays(ByRef procs() As Variant)
Dim avarNamesButtons As Variant
Dim avarNamesSubs As Variant
Dim bytMaxRow As Long
Dim bytMaxCol As Long
Dim bytCountButtons As Long
Dim lngBtnW As Long
Dim lngTop As Long
Dim lngLeft As Long
Dim bytLoopBtn As Long
Dim strSubName As String
Dim bytBracketStart As Byte
Dim bytLoopCol As Long
Dim oBtn As MSForms.CommandButton
Dim oBtnEvent As cButtons
Set oColl = New Collection
'create two sub arrays from input array
avarNamesSubs = Get1DArr_varEveryEvenElement(procs(), False)
avarNamesButtons = Get1DArr_varEveryEvenElement(procs(), True)
Erase procs()
'buttons - calc required total no + max row + max col
Call SetMaxRowsAndCols(avarNamesButtons, bytMaxRow, bytMaxCol, bytCountButtons)
'buttons - calc width
lngBtnW = Get1DArr_lngElementMaxLen(avarNamesButtons)
lngBtnW = lngBtnW * msngcWidthMultiplier
'Loop through the procedures and add a button for each
lngLeft = mbytcMarginW
lngTop = mbytcMarginH
bytLoopCol = 0
For bytLoopBtn = 1 To bytCountButtons
strSubName = vbNullString
bytBracketStart = vbNull
'Add the button and set the properties
Set oBtn = Me.Controls.Add("Forms.CommandButton.1")
With oBtn
.Left = lngLeft
.Top = lngTop
.Width = lngBtnW
.Height = mbytcButtonH
Select Case bytLoopBtn
Case bytCountButtons
'last button is exit button
.Caption = "Exit"
.Accelerator = "X"
Case Else
.Caption = avarNamesButtons(bytLoopBtn)
strSubName = avarNamesSubs(bytLoopBtn)
bytBracketStart = InStr(1, strSubName, "(")
If bytBracketStart = 0 Then
.Tag = 0
Else
bytBracketStart = bytBracketStart
.Tag = Mid(strSubName, bytBracketStart + 1, 2)
End If
End Select
End With
'Create an instance of our event handling class for each button
Set oBtnEvent = New cButtons
Set oBtnEvent.Parent = Me
Set oBtnEvent.Button = oBtn 'Tell it which button it should listen for events from
Select Case bytLoopBtn
Case bytCountButtons
'last button is exit button
oBtnEvent.SubToExecute = mstrcSubCloseForm
oColl.Add oBtnEvent 'Stick it in the collection
Case Else
If bytBracketStart = 0 Then
oBtnEvent.SubToExecute = strSubName 'Tell it which proc to run when clicked
Else
oBtnEvent.SubToExecute = Left(strSubName, bytBracketStart - 1)
End If
oColl.Add oBtnEvent 'Stick it in the collection
End Select
'add new button - completed loop
bytLoopCol = bytLoopCol + 1
'set position next button
If bytLoopCol = bytMaxCol Then
'start next row
bytLoopCol = 0
lngLeft = mbytcMarginW
lngTop = lngTop + mbytcMarginH + oBtn.Height
Else 'start next col
lngLeft = lngLeft + mbytcMarginW + lngBtnW
End If
Next bytLoopBtn
'set Form dimensions
Me.Height = (mbytcButtonH + mbytcMarginH) * (bytMaxRow + 1) - mbytcMarginH
Me.Width = (lngBtnW + mbytcMarginW) * (bytMaxCol) + (mbytcMarginW * 2)
'remove
Erase avarNamesButtons
Erase avarNamesSubs
bytLoopBtn = vbNull
bytLoopCol = vbNull
lngTop = vbNull
lngLeft = vbNull
bytCountButtons = vbNull
End Sub
Public Sub Btn_Click(ByVal sSubToRun As String, Optional ByVal varTag As Variant)
If sSubToRun = mstrcSubCloseForm Then
Application.Run sSubToRun
Exit Sub
End If
Me.Hide
If varTag > 0 Then
Application.Run sSubToRun, varTag
Else
Application.Run sSubToRun
End If
Me.Show
End Sub
Private Sub SetMaxRowsAndCols(ByRef varMacroArray As Variant, _
ByRef bytMaxRow As Long, _
ByRef bytMaxCol As Long, _
ByRef bytCountButtons As Long)
Dim bytTest As Long
'Count no. of buttons required
bytCountButtons = UBound(varMacroArray) - LBound(varMacroArray) + 1 '+1 to make result inclusive
'add 1 more button (for the Exit button)
bytCountButtons = bytCountButtons + 1
'determine how many rows/columns to use
'use preset layouts for low number of buttons
Select Case bytCountButtons
Case Is < 5: 'i x 1
bytMaxRow = bytCountButtons
bytMaxCol = 1
Case 5 To 6:
bytMaxRow = 3
bytMaxCol = 2
Case 7 To 8:
bytMaxRow = 4
bytMaxCol = 2
Case 9:
bytMaxRow = 3
bytMaxCol = 3
Case 10: '2 x 5
bytMaxRow = 5
bytMaxCol = 2
Case 11 To 12:
bytMaxRow = 4
bytMaxCol = 3
Case 13 To 15:
bytMaxRow = 5
bytMaxCol = 3
Case 16
bytMaxRow = 4
bytMaxCol = 4
Case 17 To 18
bytMaxRow = 6
bytMaxCol = 3
Case 19 To 20
bytMaxRow = 5
bytMaxCol = 4
Case 21
bytMaxRow = 7
bytMaxCol = 3
Case Else
End Select
If bytMaxCol > 0 Then Exit Sub
' somehow work out a formula to pick a pleasing ratio of rows to columns...
Rem maybe something closer to a Fibonacci/Golden Ratio
'=SQRT(A1*((1+SQRT(5))/2)^3)/((1+SQRT(5))/2)
'=SQRT(A1*((1+SQRT(5))/2)^3)/((1+SQRT(5))/2)^2
bytTest = bytCountButtons
Do Until bytMaxCol > 0
If bytTest Mod 5 = 0 Then
bytMaxCol = 5
ElseIf bytTest Mod 7 = 0 Then bytMaxCol = 7
ElseIf bytTest Mod 9 = 0 Then bytMaxCol = 9
End If
bytTest = bytTest + 1
Loop
Solved:
'work out rows from no. of columns chosen
bytMaxRow = bytCountButtons / bytMaxCol
End Sub
Module code:
Option Explicit
Option Private Module
'To hold the classes, object level so the classes don't go out of scope once the init sub has run
Public oColl As Collection
Public Sub CreateTempFormAlt(ByRef varMacroArray() As Variant, _
Optional ByVal strFormCaption As String = "MENU")
Dim uf As ufBaseForm: Set uf = New ufBaseForm
ufBaseForm.SetButtonsFromArrays varMacroArray
ufBaseForm.Caption = strFormCaption
ufBaseForm.Show
End Sub
Public Sub CloseTempForm()
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Set oColl = Nothing
Debug.Print "attempt to unload form"
Unload ufBaseForm
Application.EnableEvents = True
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Class code:
Option Explicit
Private p_sSubToExecute As String
Private p_oParent As ufBaseForm
Private WithEvents oBtn As MSForms.CommandButton
Public Property Set Parent(RHS As ufBaseForm)
Set p_oParent = RHS
End Property
Public Property Get Parent() As ufBaseForm
Set Parent = p_oParent
End Property
Public Property Let SubToExecute(RHS As String)
p_sSubToExecute = RHS
End Property
Public Property Get SubToExecute() As String
SubToExecute = p_sSubToExecute
End Property
Public Property Set Button(RHS As MSForms.CommandButton)
Set oBtn = RHS
End Property
Private Sub oBtn_Click()
Call Me.Parent.Btn_Click(Me.SubToExecute, oBtn.Tag)
End Sub
There are a few array functions used by the code above, see below:
Public Function Get1DArr_lngElementMaxLen(ByRef var1DArray As Variant) As Long
Dim lngMaxLen As Long
Dim bytElement As Byte
' validate non optional arguments
If Not NoOfDimensionsInArray(var1DArray) = 1 Then Exit Function 'input must be 1D array
' loop
For bytElement = LBound(var1DArray) To UBound(var1DArray)
If Len(var1DArray(bytElement)) > lngMaxLen Then lngMaxLen = _
Len(var1DArray(bytElement))
Next bytElement
Get1DArr_lngElementMaxLen = lngMaxLen
End Function
Public Function NoOfDimensionsInArray(ByVal varArray As Variant) As Byte
'\ returns number of dimensions as 0 - 4
'\ 0 = not an array, 4 = anything above 3 dimensions
Dim bytDimNum As Byte
Dim varErrorCheck As Variant
On Error GoTo FinalDimension
For bytDimNum = 1 To 4
varErrorCheck = LBound(varArray, bytDimNum)
Next
FinalDimension:
On Error GoTo 0
NoOfDimensionsInArray = bytDimNum - 1
End Function
Public Function Get1DArr_varEveryEvenElement(ByRef var1DArray As Variant, _
Optional ByVal blnOddVersion As Boolean = False) As Variant
Dim avarOutput As Variant
Dim bytElementIn As Byte
Dim bytElementOut As Byte
' validate non optional arguments
If Not NoOfDimensionsInArray(var1DArray) = 1 Then Exit Function 'input must be 1D array
' convert input array to Base 1 if not already
Call Force1DArrToBase1(var1DArray)
' create output array
If Not bytElementIn Mod 2 = 0 Then
bytElementOut = UBound(var1DArray) + 1 / 2
Else
bytElementOut = UBound(var1DArray) / 2
End If
ReDim avarOutput(1 To bytElementOut)
' loop
bytElementOut = 1
If blnOddVersion = False Then
'all even elements
For bytElementIn = LBound(var1DArray) To UBound(var1DArray)
If bytElementIn Mod 2 = 0 Then
avarOutput(bytElementOut) = var1DArray(bytElementIn)
bytElementOut = bytElementOut + 1
End If
Next bytElementIn
Else
'all odd elements
For bytElementIn = LBound(var1DArray) To UBound(var1DArray)
If Not bytElementIn Mod 2 = 0 Then
avarOutput(bytElementOut) = var1DArray(bytElementIn)
bytElementOut = bytElementOut + 1
End If
Next bytElementIn
End If
Get1DArr_varEveryEvenElement = avarOutput
End Function
LinkBack URL
About LinkBacks
Register To Reply
). See attached.
)
Originally Posted by Kyle123
I'm confused "adding controls without adding them to the project"? Could you give a quick demo?
Re: Add Command Buttons to User Form at Runtime
Bookmarks