VBA - 将相同的鼠标移动代码应用于所有标签(事件处理集合)

Question

我的工作表上有几个标签，每个标签都有以下代码，可以在状态栏上显示它们当前所在的范围(当鼠标移到它们上时(：

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
rng = ActiveSheet.Shapes("Label1").TopLeftCell.Address
Application.StatusBar = rng
End Sub

有什么方法可以将相同的代码应用于所有标签，而不是一遍又一遍地重写它？

Answer 1

我添加了一个名为LabelHandler的新类：

Option Explicit
    Public WithEvents lbl As msforms.Label
Private Sub lbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim rng As String
    rng = ActiveSheet.Shapes(lbl.Name).TopLeftCell.Address
    Application.StatusBar = rng
End Sub

在新模块中，我添加了以下内容：

Public myLabels As Collection 'Of LabelHandler
    Sub init()
    Dim ws As Worksheet
    Dim myLabel As LabelHandler
        Set myLabels = New Collection
       For Each l In ActiveSheet.OLEObjects
            Set myLabel = New LabelHandler
            Set myLabel.lbl = l.Object
            myLabels.Add myLabel
       Next
    End Sub

现在，当我将光标移到标签上时，我在状态窗口中得到 $F$11

编辑您需要编辑 For Each 循环，以便仅将所需的标签对象添加到集合中。也许是他们的Name属性

   For Each l In ActiveSheet.OLEObjects
        If Left(l.Name,5)="Label" Then
             Set myLabel = New LabelHandler
             Set myLabel.lbl = l.Object
             myLabels.Add myLabel
        End If
   Next

或者对于所有标签：

   For Each l In ActiveSheet.OLEObjects
        If l.progID = "Forms.Label.1" Then
             Set myLabel = New LabelHandler
             Set myLabel.lbl = l.Object
             myLabels.Add myLabel
        End If
   Next