Creating an OnClick event for an autopopulated userform

[MarkNumskull]

Hi,

Im very stuck at the minute and would love some help from you genius'!

I have created a userform that is programmatically populated with labels & text boxes at runtime. It is to create an internet bulletin board style interface for internal communications. One of the labels that appears under each 'post' is a ReadMore label.

As the labels are populated at runtime i cannot call a ReadMore1_onClick() event as it does not exist in the modules for the userform.

Does anybody know how to create a procedure with a variable name so that no matter matter which label is clicked whether ReadMore1 or ReadMore200 an event occurs.

What I want to happen is another form opens and populated with the full text of the 'post' hen the label is clicked.

I am very stumped by this. I have attached my code that is activated at the Userform_activate() event.

[VBA]Private Sub UserForm_Activate()

Dim CommDetails As String
Dim CommTitle As String
Dim CommSum As String
Dim ReadMore As String
Dim Source As String
Dim DateAdded As String
Dim TimeAdded As String
Dim FirstName As String
Dim LastName As String
Dim Divider As String

Dim i As Integer


i = 1
Source = frmMaintenance.TextBox4.Text
FirstOpen = True

With Me.ComboBox1
.AddItem "1 Month"
.AddItem "2 Months"
.AddItem "6 Months"
.AddItem "All"
.ListIndex = 0
End With

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source = " & Source & ""

rst.Open "SELECT tblCommunications.CommName, tblCommunications.DateAdded, tblCommunications.TimeAdded, tblCommunications.UserName, tblCommunications.CommSummary, tblStaffList.UserName, tblStaffList.FirstName, tblStaffList.LastName " & _
"FROM tblCommunications " & _
"LEFT JOIN tblStaffList " & _
"ON tblCommunications.Username = tblStaffList.Username " & _
"WHERE ((Date() - tblCommunications.DateAdded) <= 30) ORDER BY tblCommunications.DateAdded Desc", cnn

rst.MoveFirst

Do
With Me.frmContent.Controls
.Add "Forms.Label.1", "CommDetails" & i
.Add "Forms.Label.1", "CommTitle" & i
.Add "Forms.TextBox.1", "CommSum" & i
.Add "Forms.Label.1", "ReadMore" & i
.Add "Forms.Image.1", "Divider" & i
End With

DateAdded = Format(rst![DateAdded], "DDDDDD")
TimeAdded = Format(rst![TimeAdded], "HH:MM")
FirstName = rst![FirstName]
LastName = rst![LastName]

Me.Image1.BorderStyle = fmBorderStyleNone


With Me.Controls("CommDetails" & i)
.Caption = "Added by " & FirstName & " " & LastName & " " & DateAdded & " " & TimeAdded
.Font.Name = "Arial"
.Font.Size = "8"
.Font.Bold = False
.ForeColor = &H808080
.BackColor = &HFFFFFF
.Height = 12
.Width = 607
.left = 5
If i = 1 Then
.top = 18.8
Else
.top = Me.Controls("CommDetails" & (i - 1)).top + 78
End If
End With

With Me.Controls("CommTitle" & i)
.Caption = rst![CommName]
.Font.Name = "Arial"
.Font.Size = "14"
.Font.Bold = True
.ForeColor = &H8000000D
.BackColor = &HFFFFFF
.Height = 18
.Width = 607
.left = 5
If i = 1 Then
.top = 2.3
Else
.top = Me.Controls("CommTitle" & (i - 1)).top + 78
End If
End With

With Me.Controls("CommSum" & i)
.Text = rst![CommSummary]
.Font.Name = "Arial"
.Font.Size = "11"
.Font.Bold = False
.MultiLine = True
.BackStyle = fmBackStyleOpaque
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.BackColor = &HFFFFFF
.Locked = True
.Height = 30
.Width = 607
.left = 5
If i = 1 Then
.top = 31
Else
.top = Me.Controls("CommSum" & (i - 1)).top + 78
End If
End With

With Me.Controls("ReadMore" & i)
.Caption = "Read More >>"
.Font.Name = "Arial"
.Font.Size = "11"
.Font.Bold = True
.MousePointer = fmMousePointerCustom
.MouseIcon = LoadPicture("C:\Users\Mark.MSERV\Documents\My Dropbox\Tech 2nd Year\Knowledge Base\Project\Mousemovelabel\Hand.ico")
.ForeColor = &H8000000D
.BackColor = &HFFFFFF
.Height = 15.75
.Width = 607
.left = 5
If i = 1 Then
.top = 61
Else
.top = Me.Controls("ReadMore" & (i - 1)).top + 78
End If
End With

With Me.Controls("Divider" & i)
.Picture = LoadPicture("C:\Users\Mark.MSERV\Documents\My Dropbox\Tech 2nd Year\Knowledge Base\Project\Gradient.jpg")
.PictureSizeMode = fmPictureSizeModeStretch
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.Height = 3
.Width = 607
.left = 5
If i = 1 Then
.top = 75
Else
.top = Me.Controls("Divider" & (i - 1)).top + 78
End If
End With

rst.MoveNext
i = i + 1
Loop Until rst.EOF

rst.Close

Me.frmContent.ScrollHeight = Me.Controls("ReadMore" & (i - 1)).top + 50

Me.Label44.Caption = i - 1 & " communications found"
FirstOpen = False

End Sub
[/VBA]

Any help would be much appreciated!

Mark

[mikerickson]

You can use a class module to create event code that is common for any label.

First, insert a Class Module and name it clsAnyLabel and put this code in that module. The AnyLabel_Click event can be altered to meet your needs. Note that it refers to the Userform by "AnyLabel.Parent"
[VBA]Public WithEvents AnyLabel As MSForms.Label

Private Sub AnyLabel_Click()
With AnyLabel
MsgBox "You clicked on " & .Parent.Name & "." & .Name
End With
End Sub[/VBA]

Then in your Userform code, you can use code like this. CommandButton1 creates a new label and assigns the common event code to that label. CommandButton2 assigns all labels to the common code. CommandButton3 shows a technique for assigning only particular (already existing) labels to the common code.
Note the cleanup in the Userform_Terminate event
in a userform's code module[VBA]Dim myLabels As New Collection

Private Sub CommandButton1_Click()
Dim aLabel As New clsAnyLabel

Rem create new label
Set aLabel.AnyLabel = Me.Controls.Add("Forms.Label.1")
With aLabel.AnyLabel
.Top = 10: .Left = 10
.Height = 22: .Width = 75
.Font.Size = 12
.Caption = "hello"
End With

Rem assign it to common code
On Error Resume Next
myLabels.Add Item:=aLabel, Key:=aLabel.AnyLabel.Name
On Error GoTo 0

Set aLabel = Nothing
End Sub

Private Sub CommandButton2_Click()
Dim aLabel As clsAnyLabel
Dim oneControl As Object
For Each oneControl In Me.Controls
If TypeName(oneControl) = "Label" Then
Set aLabel = New clsAnyLabel
Set aLabel.AnyLabel = oneControl
On Error Resume Next
myLabels.Add Item:=aLabel, Key:=aLabel.AnyLabel.Name
On Error GoTo 0
End If
Next oneControl
Set aLabel = Nothing
End Sub

Private Sub CommandButton3_Click()
Dim oneName As Variant
Dim aLabel As clsAnyLabel
For Each oneName In Array("myFirstLabel", "mySecondLabel")
Set aLabel = New clsAnyLabel
Set aLabel.AnyLabel = Me.Controls(oneName)
On Error Resume Next
myLabels.Add Item:=aLabel, Key:=aLabel.AnyLabel.Name
On Error GoTo 0
Next oneName
Set aLabel = Nothing
End Sub

Private Sub UserForm_Terminate()
Dim oneControl As Object
For Each oneControl In myLabels
Set oneControl = Nothing
Next oneControl
Set myLabels = Nothing
End Sub[/VBA]

[MarkNumskull]

Hi!

Thanks for that its really useful. Can i add an if statement into the class module to read something like

[VBA]Public WithEvents AnyLabel As MSForms.Label

Private Sub AnyLabel_Click()

If AnyLabel.Name = "ReadMore" Then
With AnyLabel
"Procedure is put here"
End With
End If
End Sub [/VBA]

[mikerickson]

What happened when you tried it?

[MarkNumskull]

I got confused and it didn't work.

In relation to my code, i would need both the class module and then one of the pieces of code from the second VBA statement you have shown? I am unsure how to make this work with my code, its just me being an idiot im sure but i can't figure it out :s

[Kenneth Hobs]

I attached an example. Hopefully, it is working as Mike intended.

[MarkNumskull]

Hi!

This is excellent, thank you both for this, with a little modification I got it doing what I wanted, you have saved me so much time and headache with this, thanks!!!

Mark

[UselessBug]

I attached an example. Hopefully, it is working as Mike intended.

Hi
This is such a great help! Thank you so much