动态创建的表单控件标签上的 MouseMove 事件

Question

我试图在 VBA 中动态创建一个形状，然后为其分配一个鼠标事件，这样如果用户将鼠标移到该形状上，就会触发一个事件。

我在这个论坛和互联网上的其他地方进行了搜索，发现形状不能关联事件。解决方法是在顶部添加一个 from 控件（如 Label）并向其添加一个事件。

由于我是动态创建标签，我明白我需要创建自定义 Class 并定义标签 WithEvents 来触发事件。我写了下面的代码，但收到错误

"Object does not source automation events".

Class 定义的代码：

'Class name clsEventShape

Public WithEvents evtLabel As Label

Private Sub evtLabel_mousemove()
    MsgBox "Mouse Moved!!"
End Sub

生成形状和标签的代码：

Option Explicit
Option Base 1

Dim Lbl As Label
Dim evtLbl As clsEventShape
Dim Shp As Shape
Dim WS As Worksheet

Public Sub addShape()
    WS = ActiveSheet

    Set Shp = WS.Shapes.addShape(msoShapeRoundedRectangle, 10, 10, 100, 100)

    With Shp
        .Fill.ForeColor.RGB = RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255)
    End With

    evtLbl = New clsEventShape
    Set evtLbl.evtLabel = WS.Controls.Add("Form.Label.1")
    Set Lbl = evtLbl.evtLabel

    With Lbl
        .Left = 10
        .Top = 10
        .Width = 100
        .Height = 100
        .Caption = "Hello"
    End With 
End Sub

Answer 1

鼠标移动事件有参数：

Public WithEvents evtLabel As msforms.Label

Private Sub evtLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 MsgBox "Mouse Moved!!"
End Sub

您的模块中的代码略有更改：

Option Explicit
Option Base 1

Dim Lbl As OLEObject
Dim evtLbl As clsEventShape
Dim Shp As Shape
Dim WS As Worksheet

    Public Sub addShape()
  Set WS = ActiveSheet

    Set Shp = WS.Shapes.addShape(msoShapeRoundedRectangle, 10, 10, 100, 100)

    With Shp
        .Fill.ForeColor.RGB = RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255)
    End With

    Set evtLbl = New clsEventShape
    Set Lbl = WS.OLEObjects.Add("Forms.Label.1")
    Set evtLbl.evtLabel = Lbl.Object
    With Lbl
        .Left = 10
        .Top = 10
        .Width = 100
        .Height = 100
        .Object.Caption = "Hello"
        .Object.BackStyle = fmBackStyleTransparent 'added
     End With
    WS.Shapes(Lbl.Name).Fill.Transparency = 1 'added
End Sub

动态创建的表单控件标签上的 MouseMove 事件

MouseMove event on dynamically created Form Control Label

excel

vba

event-handling

mouseevent