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

Question

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

我在这个论坛和互联网上的其他地方进行了搜索，并意识到形状不能关联事件。解决方法是在顶部添加一个来自控件（如标签）并为其添加一个事件。

由于我是动态创建标签，因此我了解我需要创建自定义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

标签： excelvbaevent-handlingmouseevent

Answer 1

• mousemove-event 有参数：

  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