Add MouseMove action to dynamically created form controls

**AdLoki** · 09-17-2012, 09:43 AM

Hi all,

I have a form in which a grid of label controls is created dynamically when the form is initialised. I want to assign an action to each of these controls, triggered when the cursor hovers over each one.

At present I am creating the controls from within the form's code, rather than in a class module (which I still don't fully understand).

Does anyone know of a way to assign such an action trigger?

I have tried to assign just a simple click event using the .OnAction property but even this doesn't seem to be accepted.

Below is the code that creates the labels ('tiles'). Can anyone point me in the right direction? If a MouseMove property cannot be assigned, I'd settle for a straight forward click.

Thanks

For n = 1 To (25 * 15)

Set tile = Me.Controls.Add("forms.label.1")

With tile
    With Sheets("Align")
        oRow = n + 1
        tile.name = .Cells(oRow, 2).Value
        tile.Tag = "RAG"
        
        ColOff = Left(tile.name, InStrRev(tile.name, "_") - 1)
        ColOff = Right(ColOff, Len(ColOff) - InStr(ColOff, "_"))
        RowOff = Right(tile.name, Len(tile.name) - InStrRev(tile.name, "_"))
        
        If (Val(ColOff) > IndNum) Or (Val(RowOff) > LocNum) Then
            tile.Visible = False
        Else
            tile.Visible = True
            tile.BackStyle = 1
            tile.Left = .Cells(oRow, 3).Value
            tile.Top = .Cells(oRow, 4).Value
            tile.Width = 20
            tile.Height = 20
            tile.BorderStyle = 1
            tile.BorderColor = RGB(255, 255, 255)
            tile.ZOrder msoBringToFront
            
'            tile.OnAction = "TileZoom"
            
            ReDim Preserve TileArray(1 To n)
        End If
    
    End With
End With

Next n

**Domenic** · 09-18-2012, 06:21 PM

I believe it's possible. However, have you considered adding the controls and event handlers at design time and making them visible when needed?

**AdLoki** · 09-26-2012, 12:42 PM

I started doing that but my grid of tiles is 15 x 25 and it is a lot easier to create the objects ad hoc... I haven't even been able to assign a simple click event to a dynamically created label - I think that the 'OnAction' method only works with CommandButtons...

\really wish I could crack this as it would make my project a lot more versatile. Any suggestions welcome!

**Domenic** · 09-26-2012, 03:49 PM

I haven't fully tested the following code, but it should create your labels and corresponding MouseMove event handlers for your UserForm. Note that the code needs to be placed in a standard module (Insert > Module). Also, you'll need to change the specified UserForm name, if necessary. By the way, I'm not sure what you're doing with TileArray, but I'll leave it for you to deal with.

Sub CreateLabels()

    'Dim TileArray() As Variant
    Dim wksSource As Worksheet
    Dim strUserFormName As String
    Dim tile As MSForms.Label
    Dim TextLocation As Long
    Dim StartLine As Long
    Dim oRow As Long
    Dim ColOff As Long
    Dim RowOff As Long
    Dim IndNum As Long
    Dim LocNum As Long
    Dim n As Long
    
    Set wksSource = Worksheets("Align")
    
    strUserFormName = "UserForm1" 'change the UserForm name accordingly
    
    For n = 1 To (25 * 15)
    
        Set tile = ThisWorkbook.VBProject.VBComponents(strUserFormName).Designer.Controls.Add("Forms.Label.1")
        
        With tile
        
            oRow = n + 1
            .Name = wksSource.Cells(oRow, 2).Value
            .Tag = "RAG"
            
            ColOff = Left(.Name, InStrRev(.Name, "_") - 1)
            ColOff = Right(ColOff, Len(ColOff) - InStr(ColOff, "_"))
            RowOff = Right(.Name, Len(.Name) - InStrRev(.Name, "_"))
            
            If (Val(ColOff) > IndNum) Or (Val(RowOff) > LocNum) Then
                .Visible = False
            Else
                .Visible = True
                .BackStyle = 1
                .Left = wksSource.Cells(oRow, 3).Value
                .Top = wksSource.Cells(oRow, 4).Value
                .Width = 20
                .Height = 20
                .BorderStyle = 1
                .BorderColor = RGB(255, 255, 255)
                .ZOrder msoBringToFront
                With ThisWorkbook.VBProject.VBComponents(strUserFormName).CodeModule
                    TextLocation = .CreateEventProc("MouseMove", tile.Name)
                    .InsertLines TextLocation + 1, "Call TileZoom"
                End With
                'ReDim Preserve TileArray(1 To n)
            End If
        End With
    
    Next n
    
    VBA.UserForms.Add(strUserFormName).Show

End Sub

**AdLoki** · 09-27-2012, 09:45 AM

Many thanks Domenic.

I used a modified version of your code, which didn't work but i now know that this is because you cannot have special characters in the object name when using .CreateEventProc (I have underscores in the names of my 'tile' objects) - something to bear in mind for anyone else thinking of using this method.

Having said that, I have tried to use this code to allocate a click event to a different dynamically-created object and it was correctly inserting the code but for some reason not working. I am sure i can get it to work if I plug away at it for long enough but it occurs to me that adding lines of code dynamically may not be the most efficient way of achieving my goal - I will need to delete the relevant code each time the UserForm is deactivated and, within the scope of the tool I am building, this will likely happen a lot.

Can you (or anyone else) just confirm for me that there is no other way of allocating an event to a dynamically-created label? If not, then I will pursue this route but I'm still hoping that there's an alternative...

All thoughts very welcome!

**AdLoki** · 09-27-2012, 09:50 AM

Many thanks Domenic.

I used a modified version of your code, which didn't work but i now know that this is because you cannot have special characters in the object name when using .CreateEventProc (I have underscores in the names of my 'tile' objects) - something to bear in mind for anyone else thinking of using this method.

Having said that, I have tried to use this code to allocate a click event to a different dynamically-created object and it was correctly inserting the code but for some reason not working. I am sure i can get it to work if I plug away at it for long enough but it occurs to me that adding lines of code dynamically may not be the most efficient way of achieving my goal - I will need to delete the relevant code each time the UserForm is deactivated and, within the scope of the tool I am building, this will likely happen a lot.

Can you (or anyone else) just confirm for me that there is no other way of allocating an event to a dynamically-created label? If not, then I will pursue this route but I'm still hoping that there's an alternative...

All thoughts very welcome!

**buran** · 09-27-2012, 10:13 AM

Well, the alternative is to use class. At least for the MouseMove event. This way you will have single event handler for all tiles, not 375 virtually same subroutines.
You can leave the code that adds the controls in the Initialize routine.
You do know that you must have trust access to VBA project object model in order to be able to add code on the fly, right? This may cause your code not working if such access is not granted in advance.

**Kyle123** · 09-27-2012, 10:23 AM

Like this, useform code:

Private LabelCollection As Collection

Private Sub UserForm_Click()

Dim lb As CLabelEvents
Set LabelCollection = New Collection

For n = 1 To (25 * 15)

Set tile = Me.Controls.Add("forms.label.1")

With tile
    With Sheets("Align")
        oRow = n + 1
        tile.Name = .Cells(oRow, 2).Value
        tile.Tag = "RAG"

        ColOff = Left(tile.Name, InStrRev(tile.Name, "_") - 1)
        ColOff = Right(ColOff, Len(ColOff) - InStr(ColOff, "_"))
        RowOff = Right(tile.Name, Len(tile.Name) - InStrRev(tile.Name, "_"))

        If (Val(ColOff) > IndNum) Or (Val(RowOff) > LocNum) Then
            tile.Visible = False
        Else
            tile.Visible = True
            tile.BackStyle = 1
            tile.Left = .Cells(oRow, 3).Value
            tile.Top = .Cells(oRow, 4).Value
            tile.Width = 20
            tile.Height = 20
            tile.BorderStyle = 1
            tile.BorderColor = RGB(255, 255, 255)
            tile.ZOrder msoBringToFront

'            tile.OnAction = "TileZoom"

            ReDim Preserve TileArray(1 To n)
        End If

    End With
End With

Set lb = New CLabelEvents
Set lb.lb = tile
LabelCollection.Add lb
Next n
End Sub

Class Code - Class is named CLabelEvents

Private WithEvents m_objlb As msforms.Label

Public Property Get lb() As msforms.Label

    Set lb = m_objlb

End Property

Public Property Set lb(objlb As msforms.Label)

    Set m_objlb = objlb

End Property

Private Sub m_objlb_Click()
    MsgBox m_objlb.Caption
End Sub

**Domenic** · 09-27-2012, 11:10 AM

@ buran,

Thanks for pointing out that the code requires 'trust access to VBA project object model'.

@ AdLoki,

It looks like using a class module is the way to go. Since I'm not as yet very familiar with class modules, I'll leave you in Kyle's very capable hands.

**AdLoki** · 09-27-2012, 02:49 PM

Kyle, thanks for this - it looks interesting. I'm attempting to implement it but I'm getting a custom-defined type error with CLabelEvents. Do I need to install a new reference library for this to work?

Many thanks,
Ad

**Kyle123** · 09-27-2012, 03:02 PM

No, you just need to name the class CLabelEvents, its in the properties

**AdLoki** · 09-27-2012, 03:24 PM

That was so obvious, i can't believe that I didn't realise! Thanks very much, this works a treat

Nuff respec

**Kyle123** · 09-27-2012, 03:27 PM

Great stuff, glad it's working

welcome to the wonderful world of classes!

**AntrobusJ** · 03-19-2013, 07:39 AM

Hello, Sorry to re-active an old post however this is the post that helped me get this far.

The problem I seem to be running into is that if I click on a label or MouseMove of a label, it does nothing.
I have put a break in, to see if its setting the lb, and it sets but does not activate the code in the class when a label is clicked.
Any help would be much appreciated.

Here is my code:

Form Code:

                For n = 2 To A
                    Set LCtrl = .Controls.Add("Forms.Label.1", "MyLabel", True)
                    With LCtrl
                        .Caption = Sheets(i).Range(Chr(64 + n) & "4").Value
                        .Name = "Lbl" & Replace(Sheets(i).Range(Chr(64 + n) & "4").Value, " ", "")
                        .Width = 96
                        .Height = 12
                        .Top = Topper
                        .BorderStyle = 1
                        .TextAlign = 2
                        If ((n Mod 2) = 0) Then
                            .Left = 1.5
                        Else
                            .Left = 99.5
                            Topper = Topper + 13
                        End If
                    End With
                    
                    Set lb = New CLabelEvents
                    Set lb.lb = LCtrl
                    LabelCollection.Add lb
                Next n

CLabelEvents Class

Private WithEvents m_objlb As MSForms.Label

Public Property Get lb() As MSForms.Label
    Set lb = m_objlb
End Property

Public Property Set lb(objlb As MSForms.Label)
    Set m_objlb = objlb
End Property

Private Sub m_objlb_Click()
    MsgBox m_objlb.Caption
End Sub

Private Sub m_objlb_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MsgBox m_objlb.Caption
End Sub

**AntrobusJ** · 03-19-2013, 08:37 AM

Anyone got any ideas on what could be going wrong? I am happy to admit that I don't know much about Classes, so it is most likely something I'm doing wrong.

**Kyle123** · 03-19-2013, 08:40 AM

Where is your collection declared?

**AntrobusJ** · 03-19-2013, 08:45 AM

Above the Private Sub UserForm_Initialize.

Private LabelCollection As Collection
Private Sub UserForm_Initialize()
    Dim lb As CLabelEvents
    Set LabelCollection = New Collection

    TxtMaxRows.Enabled = False
    ChkList.Enabled = False
    CmbVLoc.AddItem "Right"
    CmbVLoc.AddItem "Bottom"
    CmbVLoc.Text = "Right"
    
    CmbCWidth.AddItem "2"
    CmbCWidth.AddItem "3"
    CmbCWidth.AddItem "4"
    CmbCWidth.AddItem "6"
    CmbCWidth.Text = "2"
    
    Dim MPctrl As Control
    Dim PCtrl As Control
    Dim LCtrl As Control
    
    Set MPctrl = Me.Controls.Add("Forms.MultiPage.1", "MyPage", True)
    With MPctrl
        For i = 1 To .Count
            .Pages.Remove "Page" & i
        Next i
        .Width = 200
        .Top = 20
        .Height = 250
        .Left = 462
        For i = 2 To 6 Step 2
            Set PCtrl = MPctrl.Pages.Add(Sheets(i).Name)
            With PCtrl
                Topper = 3
                A = Sheets(i).Range("C3").Value + 1
                For n = 2 To A
                    Set LCtrl = .Controls.Add("Forms.Label.1", "MyLabel", True)
                    With LCtrl
                        .Caption = Sheets(i).Range(Chr(64 + n) & "4").Value
                        .Name = "Lbl" & Replace(Sheets(i).Range(Chr(64 + n) & "4").Value, " ", "")
                        .Width = 96
                        .Height = 12
                        .Top = Topper
                        .BorderStyle = 1
                        .TextAlign = 2
                        If ((n Mod 2) = 0) Then
                            .Left = 1.5
                        Else
                            .Left = 99.5
                            Topper = Topper + 13
                        End If
                    End With
                    
                    Set lb = New CLabelEvents
                    Set lb.lb = LCtrl
                    LabelCollection.Add lb
                Next n
            End With
        Next i
    End With
End Sub

**AntrobusJ** · 03-19-2013, 08:48 AM

I'm an idiot. So sorry Kyle, but thank you so much. Without this thread I wouldn't have a clue where to begin.
I have just made this public on a module, and works fine.

Thank you so much Kyle.

**buran** · 03-19-2013, 09:09 AM

Hi,
you didn't show the entire form code. My guess would be that you have problem with the scope of LabelCollection. It must be declared at the modul level, so it remain alive after UserForm_Initialize sub is over (I assume that's where your form code is placed).


Dim LabelCollection As Collection

Private Sub UserForm_Initialize()
Set LabelCollection = New Collection

'Some code here    

    Set lb = New CLabelEvents
    Set lb.lb = LCtrl
    
    LabelCollection.Add lb

' Some code here

End Sub

Buran

Add MouseMove action to dynamically created form controls

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Re: Add MouseMove action to dynamically created form controls

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions