several handlers with same piece of code

[Lberteh]

Hi. I would like to ask for you guys help. I'm a begginer in VBA but I was asked at work to develop a VBA app and I need to finish it asap. I'm trying to learn as fast as I can but all the advanced stuff I've been searching online and writting "dirty code". I don't know exactly what I'm doing but it's working so far. I'm stuck with the following matter. The code below works like a charm.




Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Label3.ForeColor = vbWhite
Label3.SpecialEffect = 1
Label3.BackStyle = 1
Label3.BackColor = &H808000

End Sub


Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Label3.ForeColor = vbBlack
Label3.SpecialEffect = 0
Label3.BackStyle = 0

End Sub


My problem is that I need the same piece of code for other 500 Labels in the same userform. I know that it's possible to do it without writting the code for each label separately, but I had no success in the past 2 days. Would you guys help me find a solution? I tried to work with class modules and variables, but it's too advanced for me, I need a Light.


Thank you!

[p45cal]

In the userform's code-module:

Dim Labels() As New LblClass
Private Sub UserForm_Initialize()
Dim LabelCount As Long
Dim ctl As Control
' Create the Label objects
LabelCount = 0
For Each ctl In Controls
  If TypeName(ctl) = "Label" Then
    LabelCount = LabelCount + 1
    ReDim Preserve Labels(1 To LabelCount)
    Set Labels(LabelCount).LabelGroup = ctl
  End If
Next ctl
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
For Each lbl In Labels
  With lbl.LabelGroup
    .ForeColor = vbBlack
    .SpecialEffect = 0
    .BackStyle = 0
  End With
Next lbl
End Sub

Create a new Class Module, change its name to
LblClass
and paste this code in it:

Public WithEvents LabelGroup As MsForms.Label

Private Sub LabelGroup_Click() 'you don't need this sub but it serves as an example
Msg = "You clicked " & LabelGroup.Name & vbCrLf & vbCrLf
Msg = Msg & "Caption: " & LabelGroup.Caption & vbCrLf
Msg = Msg & "Left Position: " & LabelGroup.Left & vbCrLf
Msg = Msg & "Top Position: " & LabelGroup.Top
MsgBox Msg, vbInformation, LabelGroup.Name
End Sub

Private Sub LabelGroup_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
LabelGroup.ForeColor = vbWhite
LabelGroup.SpecialEffect = 1
LabelGroup.BackStyle = 1
LabelGroup.BackColor = &H808000
End Sub

Adapted from John Walkenbach's code in Excel 20nn Power Programming with VBA, where nn is one of 02, 03, 07, 10.

All above in the attachment.

[mancubus]

welcome to the forum Lberteh.

i'm wondering why someone needs their userform has 500 labels.