Adding controls at design time through code

[UpSkill]

The following code adds Labels to Userform1. However all the Labels appear on top of each other at the top left of the userform. What might the problem be?


Sub AddControls()
Dim UFvbc As VBComponent
Dim c, lb As Control
Dim r As Long
Dim x As VBIDE.VBProject


' Make sure access to the VBProject is allowed
On Error Resume Next
Set x = Workbooks(1).VBProject
If Err <> 0 Then
MsgBox "Your security settings do not allow this macro to run.", vbCritical
Exit Sub
End If

Set UFvbc = x.VBComponents("Userform1")

' Delete all controls, if any
For Each c In UFvbc.Designer.Controls
UFvbc.Designer.Controls.Remove c.Name
Next c

' Add Labels
For r = 1 To 10
Set lb = UFvbc.Designer.Controls.Add("Forms.label.1")
With lb
.Width = 25
.Height = 25
.Left = 10
.Top = (r * .Height) + 35
.Caption = Worksheets(3).Cells(r, 1)
.Tag = "ItemNo " & r
.Name = "lbItemNo" & r
End With

'Initialise the userform
VBA.UserForms.Add ("Userform1")

End Sub

Thanks for your help

[Admin]

Hi UpSkill,

Welcome to board !!

This worked for me. (Using Win 8 64 bit, Excel 2010)


Option Explicit

Sub Add_Control()

'//*************Make sure access to the VBProject is allowed***********************


' Declare variables.
Dim NewForm As Object
Dim lb As Object
Dim c As Object
Dim r As Long

' Create a new UserForm. You can use this new VBComponent object
' to manipulate the UserForm.
Set NewForm = Application.VBE.ActiveVBProject.VBComponents.Add(v bext_ct_MSForm)

With NewForm
.Properties("Caption") = "New Form"
.Properties("Width") = 200
.Properties("Height") = 350
End With
' Delete all controls, if any
For Each c In NewForm.Designer.Controls
NewForm.Designer.Remove c.Name
Next c

'Add Labels
For r = 1 To 10
Set lb = NewForm.Designer.Controls.Add("Forms.Label.1")
With lb
.Width = 50
.Height = 25
.Left = 10
.Top = (r * .Height) + 35
.Caption = Worksheets(3).Cells(r, 1)
.Tag = "ItemNo " & r
.Name = "lbItemNo" & r
End With
Next

VBA.UserForms.Add(NewForm.Name).Show

End Sub