VBA - すべてのラベルに同じMouseMoveコードを適用する（イベント処理コレクション）

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 

を今、私はラベルの上に私のカーソルを実行したときに、私は$ 11fの$を得ますステータスウィンドウで

EDIT 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