8
\$\begingroup\$

I was asked for an example of a class to wrap dynamically added controls as I suggested in this Answer. Although it is out of the context of a Code Review, I thought that it would make an interesting post.

I'm looking for feedback on not only "How to improve my code" but also "How to better explain my code".


Basic Custom Control Pattern

Basic Custom Control Pattern

Userform1: Userform

  • CustomControls:Collection - Used to store the CustomControls in memory.
  • AddCustomControls() - Add new controls to Userform1, links them to a New CustomControl. The New CustomControl is then added to the CustomControls collection.
  • CustomCombo_Change(Item:CustomContol): This public method is called by a CustomControl when the CustomControls.Combo Change event is fired.

CustomControl: Class

Withevents Demo Image

  • WithEvents Combo:MsForms.ComboBox - Using WithEvents allows the class to receive the controls events
  • Form:UserForm1 - The class stores a reference to the parent Userform so that it can trigger custom Userform events. Typically a references to either the class of to one of the classes controls is passed back to the parent form.

Advanced Custom Control Pattern

This pattern has the userform Implement an Interface. The custom class references the userform's Interface instead of the actual userform. In this way, the Custom class can be used with any other class or userform that Implements the Interface.

advanced custom control pattern


Advanced Pattern Demo

This code applies the Advanced Pattern to this post: [Loop through different controls and enabled the state of the whole group VBA] (Loop through different controls and enabled the state of the whole group VBA).

Download the demo: dynamic-control-rows.xlsm. Note: The workbook also contains the TemplateForm that I used to generate most of the code for the controls.

IItemsForm:Interface

Public Sub ItemRowUpdated(Item As ItemRow)
End Sub

ItemsForm:UserForm

Option Explicit
Implements IItemsForm
Private ItemRows As New Collection
Private Sub btnAddRows_Click()
 Dim Item As New ItemRow
 Item.Init FrameItems, Me
 Item.cboItem.List = Array("Jumper", "Shirt", "Trouser")
 ItemRows.Add Item
 SpaceItems
End Sub
Private Sub SpaceItems()
 Const PaddingTop As Double = 5
 Dim Top As Double
 Dim Item As ItemRow
 Top = PaddingTop
 Dim n As Long
 For n = 1 To ItemRows.Count
 Set Item = ItemRows(n)
 Item.ckItemNo.Caption = n
 Item.Top = Top
 Top = Top + Item.Frame.Height + PaddingTop
 Next
 EnableItems
End Sub
Private Sub EnableItems()
 Dim Item As ItemRow, PreviousItem As ItemRow
 Dim n As Long
 Dim Enabled As Boolean
 Enabled = True
 For n = 2 To ItemRows.Count
 Set PreviousItem = ItemRows(n - 1)
 Set Item = ItemRows(n)
 Item.Enabled = PreviousItem.cboItem.Value <> vbNullString
 Next
End Sub
Private Sub btnDeleteSelectedRows_Click()
 Dim Item As New ItemRow
 Dim n As Long
 For n = ItemRows.Count To 1 Step -1
 Set Item = ItemRows(n)
 If Item.ckItemNo.Value = True Then
 ItemRows.Remove n
 FrameItems.Controls.Remove Item.Frame.Name
 End If
 Next
 SpaceItems
End Sub
Private Sub IItemsForm_ItemRowUpdated(Item As ItemRow)
 EnableItems
End Sub
Private Sub UserForm_Initialize()
 btnAddRows_Click
End Sub

ItemRow: Class

Option Explicit
Public Form As IItemsForm
Public Frame As MSForms.Frame
Public ckItemNo As MSForms.CheckBox
Public WithEvents cboItem As MSForms.ComboBox
Public txtQty As MSForms.TextBox
Public txtUnitPrice As MSForms.TextBox
Public txtSubTotal As MSForms.TextBox
Public optIn As MSForms.OptionButton
Public optOut As MSForms.OptionButton
Public txtComments As MSForms.TextBox
Public Sub Init(TargetFrame As MSForms.Frame, TargetForm As IItemsForm)
 Set Form = TargetForm
 Set Frame = TargetFrame.Controls.Add("Forms.Frame.1")
 Frame.Height = 24
 Frame.Width = 630
 With Frame.Controls
 Set ckItemNo = .Add(bstrProgID:="Forms.CheckBox.1")
 With ckItemNo
 .Top = 0
 .Left = 6
 .Width = 57
 .Height = 18
 End With
 Set cboItem = .Add(bstrProgID:="Forms.ComboBox.1")
 With cboItem
 .Top = 0
 .Left = 78
 .Width = 120
 .Height = 18
 End With
 Set txtQty = .Add(bstrProgID:="Forms.TextBox.1")
 With txtQty
 .Top = 0
 .Left = 204
 .Width = 30
 .Height = 18
 End With
 Set txtUnitPrice = .Add(bstrProgID:="Forms.TextBox.1")
 With txtUnitPrice
 .Top = 0
 .Left = 240
 .Width = 60
 .Height = 18
 End With
 Set txtSubTotal = .Add(bstrProgID:="Forms.TextBox.1")
 With txtSubTotal
 .Top = 0
 .Left = 306
 .Width = 60
 .Height = 18
 End With
 Set optIn = .Add(bstrProgID:="Forms.OptionButton.1")
 With optIn
 .Top = 0
 .Left = 378
 .Width = 27
 .Height = 18
 .Caption = "IN"
 End With
 Set optOut = .Add(bstrProgID:="Forms.OptionButton.1")
 With optOut
 .Top = 0
 .Left = 408
 .Width = 38.25
 .Height = 18
 .Caption = "OUT"
 End With
 Set txtComments = .Add(bstrProgID:="Forms.TextBox.1")
 With txtComments
 .Top = 0
 .Left = 456
 .Width = 168
 .Height = 18
 End With
 End With
End Sub
Public Property Get Top() As Double
 Top = Frame.Top
End Property
Public Property Let Top(ByVal Value As Double)
 Frame.Top = Value
End Property
Public Property Get Enabled() As Boolean
 Enabled = Frame.Enabled
End Property
Public Property Let Enabled(ByVal Value As Boolean)
 Frame.Enabled = Value
 Dim Ctrl As MSForms.Control
 For Each Ctrl In Frame.Controls
 Ctrl.Enabled = Frame.Enabled
 Next
End Property
Private Sub cboItem_Change()
 Form.ItemRowUpdated Me
End Sub

Advanced Pattern Demo


Addendum

@sifar pointed out that after deleting the first row the second row will not enable itself. The frame scrollbar also needed to be set to fmScrollBarsVertical and its ScrollHeight set when there are more items then can be seen.

Code FIx

Private Sub SpaceItems()
 Const PaddingTop As Double = 5
 Dim Top As Double
 Dim Item As ItemRow
 Top = PaddingTop
 Dim n As Long
 For n = 1 To ItemRows.Count
 Set Item = ItemRows(n)
 Item.ckItemNo.Caption = n
 Item.Top = Top
 Top = Top + Item.Frame.Height + PaddingTop
 Next
 EnableItems
 Top = Top - PaddingTop
 With Me.FrameItems
 .ScrollBars = IIf(Top > .Height, fmScrollBarsVertical, fmScrollBarsNone)
 .ScrollHeight = Top
 End With
End Sub
Private Sub EnableItems()
 Dim Item As ItemRow, PreviousItem As ItemRow
 Dim n As Long
 If ItemRows.Count > 0 Then ItemRows(1).Enabled = True
 For n = 2 To ItemRows.Count
 Set PreviousItem = ItemRows(n - 1)
 Set Item = ItemRows(n)
 Item.Enabled = PreviousItem.cboItem.Value <> vbNullString
 Next
End Sub
asked Oct 10, 2018 at 0:27
\$\endgroup\$
11
  • \$\begingroup\$ Thank you for the above this will help me a lot. Much appreciated you taking the time to write all this valuable knowledge. \$\endgroup\$ Commented Oct 10, 2018 at 12:34
  • \$\begingroup\$ Can i ask you in the above example if you fill 5 rows of data and close excel down and reopen then will it still have the 5 rows of data there or will this be reseted and start a new one? Probably somewhare in the form needs a drop down to select a staff and then that will trigger a procedure that will pre populate data that is in excel table? Also is there a way to add a placeholder just to hint to the user what to put in each field? \$\endgroup\$ Commented Oct 25, 2018 at 20:58
  • \$\begingroup\$ i am trying to do the above but excel is crashing on this line Set Frame = TargetFrame.Controls.Add("Forms.Frame.1") for some reason. I've checked the controls to be the same name as your example but still it's not working. Correct me if i'm wrong but you can add your template to any frame on a userform right? My form is already on screen is when i press the add row button and goes in the public init it then crashes. \$\endgroup\$ Commented Nov 2, 2018 at 11:51
  • 1
    \$\begingroup\$ @TinMan sorry, i was using my mobile in the dark while outside home. Can enabling the vertical scrollbar resolve the visibility issue faced while adding multiple itemrows? Or does it need to be coded in the class itself? \$\endgroup\$ Commented Sep 15, 2019 at 15:39
  • 1
    \$\begingroup\$ @TinMan excellent! I only removed Top = Top - PaddingTop as i needed padding. Looks great. \$\endgroup\$ Commented Sep 16, 2019 at 4:32

0

Know someone who can answer? Share a link to this question via email, Twitter, or Facebook.

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.