Question

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

我在这个论坛以及互联网上的其他地方进行了搜索，意识到形状不能关联事件。解决方法是在顶部添加一个from控件（如Label），然后向其中添加一个事件。

由于我是动态创建标签的，所以我了解需要创建自定义Class并定义标签WithEvents来触发事件。我在下面编写了代码，但出现错误

“对象不提供自动化事件”。

类定义代码：

'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

mousemove事件具有参数：

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事件

1 个答案: