creating labels on worksheet with events

[RAYLWARD102]

I already dynamically create, many msForms.Labels on a Userform, with events; I know how to do that exceptionally well.
When it comes to replicating that process to my worksheets; I'm totally lost.
From the controls toolbox in excel, I see that I can manually add a forms or active label to my worksheet. I've sort of figured out how to create a label on the worksheet, using vba, but cannot seem to code vba to link the label to events like click. First off, do the Form labels work same as in user forms as the worksheet?

Here is my attempt at creating a worksheet label via code but totally unable to link to click event. Errors at "Set c1.test = oleobj"

Sub testingout()
    Dim oleobj As OLEObject
    Set mem1 = New Collection
    
    Set oleobj = ActiveSheet.OLEObjects.Add("Forms.Label.1")
    With oleobj
        .Height = 30
        .Width = 30
        .Left = 240.75
        .Top = 169.5
        .Name = "bob"
        Set c1 = New Class1
        Set c1.test = oleobj
        mem1.Add Item:=c1, Key:=.Name
    End With
End Sub

class1 module decalred as
Public WithEvents test As OLEObject

Here is how I successfully code a label to a user form (don't need help with this)

    Set LAB = myForm.Controls.Add("Forms.Label.1")
    With LAB
        .Caption = "some caption goes here:"
        .Height = h
        .Width = 100
        .Left = 10
        .Top =10
        .Font.Size = .Height * 0.6
        .Name = "somecontrolname"
        .SpecialEffect = fmSpecialEffectFlat
        .BackColor = vbWhite
        .BackStyle = fmBackStyleOpaque
        .ForeColor = vbBlue
        .TextAlign = fmTextAlignCenter
        Set C1 = New PlatformControls
        Set C1.test = LAB
        Mem1.Add Item:=C1, Key:=.Name
    End With

Class looks like:

Public WithEvents test As msforms.Label


Private Sub test_Click()
    MsgBox "yo!"
End Sub

 

[Jaafar Tribak]

I have adapted some code that wrote in the past and here is a Workbook example.

The following example will add 10 ActiveX labels to Sheet1 at runtime and will sink their respective click events.

1- Main worker Code in Standard Module:

Option Explicit

Option Private Module

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, ByVal lpRect As Long, ByVal bErase As Long) As Long
    Private Declare PtrSafe Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
    Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const WM_SETREDRAW = &HB

Private oClassCollection As New Collection

Private Const TARGET_SHEET = "Sheet1" [B][COLOR=#008000]'<=== Change as required.[/COLOR][/B]
Private Const NUMBER_OF_LABELS = 10  [B][COLOR=#008000] '<=== Change as required.[/COLOR][/B]


Public Sub AddLabels()

    Dim iCounter As Integer, iRow As Integer, iCol As Integer
    
    On Error GoTo errHandler
    
    ShowCursor False
    SendMessage Application.hwnd, ByVal WM_SETREDRAW, ByVal 0&, 0&
    
    Call RemoveLabels

    iCol = 1
    iRow = 1

    For iCounter = 1 To NUMBER_OF_LABELS
        With Worksheets(TARGET_SHEET).OLEObjects.Add("Forms.Label.1")
            .Height = 50
            .Width = 50
            .Left = 80 * iCol
            .Top = 140 * iRow
            .ShapeRange.AlternativeText = "Added@RunTime"
            .Object.Caption = "label" & IIf(iCounter <= NUMBER_OF_LABELS / 2, iCounter, NUMBER_OF_LABELS - iCounter + NUMBER_OF_LABELS / 2 + 1)
            .Object.BackColor = IIf(iCounter Mod 2 = 0, vbRed, vbGreen)
            .Object.Font.Bold = True
            .Object.TextAlign = fmTextAlignCenter
            .Object.BorderStyle = fmBorderStyleSingle
            .Name = .Object.Caption
        End With
        If iCounter <= NUMBER_OF_LABELS / 2 - 1 Then iCol = iCounter + 1: iRow = 1 Else iCol = NUMBER_OF_LABELS - iCounter: iRow = 2
    Next iCounter

    With Application
'        .Goto Worksheets(TARGET_SHEET).Range("A1"), Scroll:=True
        .OnTime Now, "HookLabelsEvents"
errHandler:
         SendMessage .hwnd, ByVal WM_SETREDRAW, ByVal 1&, 0&
         InvalidateRect .hwnd, 0, 0
         ShowCursor True
    End With
End Sub


Public Sub RemoveLabels()
    Dim oLabel As OLEObject
    
    For Each oLabel In Worksheets(TARGET_SHEET).OLEObjects
        If TypeOf oLabel.Object Is MSForms.Label Then
            If oLabel.ShapeRange.AlternativeText = "Added@RunTime" Then
                oLabel.Delete
            End If
        End If
    Next oLabel
End Sub


Private Sub HookLabelsEvents()
    Dim oLabel As OLEObject, oClass As Class1
    
    If oClassCollection.Count > 0 Then Exit Sub
    For Each oLabel In Worksheets(TARGET_SHEET).OLEObjects
        If TypeOf oLabel.Object Is MSForms.Label Then
            If oLabel.ShapeRange.AlternativeText = "Added@RunTime" Then
                Set oClass = New Class1
                Set oClass.oleObj = oLabel.Object
                oClassCollection.Add oClass
            End If
        End If
    Next oLabel
End Sub

2- Caller code in a Standard Module : (Must be seperate from the main code module)

Option Explicit

Public Sub Start()
    Call AddLabels
End Sub

Public Sub Finish()
    Call RemoveLabels
End Sub

3- Class Module code : (Class1)

Option Explicit

Public WithEvents oleObj As MSForms.Label

Private Sub oleObj_Click()
    MsgBox "You Clicked : " & oleObj.Name
End Sub

 

[RAYLWARD102]

awesome reply Jaafar; that should do it.