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

时间:2017-11-16 12:22:37

标签: vba excel-vba excel

我的工作表上有一些标签,每个标签都有以下代码在状态栏上显示它们当前所在的范围(当鼠标移过它们时):

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

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

1 个答案:

答案 0 :(得分:2)

我添加了一个名为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