1

我有这个用户表单（图 1），我正在尝试通过类模块应用一些自定义。因此，我的第一个目标是在单击时修改标签格式（图 2）。到目前为止一切顺利，我已经通过类模块“cLabels”完成了这项工作。现在，我的第二个目标是（这是我遇到的问题）为上述标签应用其他颜色。关键是，我不知道如何做到这一点。

我尝试创建其他名为“cUserForm”的类模块，但我不知道如何将修改后的标签传递给 cUserForm 类模块并使用它的 MouseMove 事件。我知道我可以使用 MouseMove 事件通过标准 UserForm 模块应用修改，但问题是，我不希望在我的 UserForm 模块中有任何类似的代码，我希望类模块做“脏”工作。伙计们有什么想法我该如何规避这个问题？

附加信息（但对解决问题并不重要）：我的最终目标是制作像这样的“按钮” https://drive.google.com/file/d/1ev_LNgxPqjMv0dtzlF7GSo7SOq0wDbR2/view?usp=sharing一些效果，例如 MouseHover , TabPress 等等。VBA 按钮非常难看。只是为了记录，我已经在一个标准的 UserForm 模块中完成了所有这些（如果有人想让工作簿看到我在说什么，我有它），但最终结果只是一团糟，这么多代码（这只是修改用户窗体外观的代码，想象一下当我放一些代码来做某些动作时，天哪）。

图 1

图 2

这是我到目前为止所拥有的：

用户窗体模块

Option Explicit

Private ObjLabel As cLabels
Private ObjUserForm As cUserForm

Private Sub UserForm_Initialize()

 Set ObjLabel = New cLabels
 ObjLabel.CallClasse Me
 
 Set ObjUserForm = New cUserForm
 Set ObjUserForm.UserFormValue = Me
 
End Sub

c标签

Option Explicit

'## Events/Variables/Collections
Private WithEvents clsLabel As MSForms.Label

Private ClasseObject As cLabels
Private LabelCollection As New Collection

'## Properties
Public Property Get ActiveLabel() As MSForms.Label
    Set ActiveLabel = clsLabel
End Property

Public Property Set ActiveLabel(Value As MSForms.Label)
    Set clsLabel = Value
End Property

'## Procedures/Methods
Private Sub clsLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 LabelHovered
End Sub

Public Sub CallClasse(MainObject As MSForms.UserForm)

 Dim ctrl As MSForms.Control

 For Each ctrl In MainObject.Controls

    If TypeOf ctrl Is MSForms.Label Then
        Set ClasseObject = New cLabels
        Set ClasseObject.ActiveLabel = ctrl
        LabelCollection.Add ClasseObject
    End If

 Next ctrl

End Sub

Private Sub LabelHovered()
 ActiveLabel.BackColor = vbYellow
End Sub

cUserForm

Option Explicit

'## Events/Variables/Collections
Private WithEvents clsUserForm As MSForms.UserForm
Private mActiveLabel As MSForms.Label
Private ObjLabel As New cLabels

'## Properties
Public Property Get UserFormValue() As MSForms.UserForm
    Set UserFormValue = clsUserForm
End Property

Public Property Set UserFormValue(Value As MSForms.UserForm)
    Set clsUserForm = Value
End Property

Public Property Get ActiveLabel() As MSForms.Label
    Set ActiveLabel = mActiveLabel
End Property

Public Property Set ActiveLabel(Value As MSForms.Label)
    Set mActiveLabel = Value
End Property

'## Procedures
Private Sub clsUserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'MsgBox ObjLabel.ActiveLabel.BackColor 'Got an error
End Sub

工作簿： https ://drive.google.com/file/d/1cLG4pLmC-jDaysjd_dK0EFuJ_LqYqJ-u/view?usp=sharing

4

2 回答 2

0

您无需创建单独的类模块来更改表单中的内容。只需在表单后面的代码中添加事件处理方法。（在表单编辑器中，右键单击表单并选择“查看代码”。）

您可以使用MouseMove按钮的事件来更改其颜色，然后使用MouseMove表单的事件来重置按钮颜色，如下所示：

Private Sub UserForm_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal X As Single, _
    ByVal Y As Single)

    CommandButton1.BackColor = &H8000000F
End Sub

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal X As Single, _
    ByVal Y As Single)

    CommandButton1.BackColor = vbYellow
End Sub
于 2020-07-23T16:24:53.287 回答
0

我发现您的问题非常有趣，并且我对如何执行此操作有一些不同的，更面向对象的看法。我尝试实现一个观察者模式来获得所描述的效果。（作为旁注，通常我会使用接口更多地概括解决方案，但是对于这个快速演示，我将展示几个紧密耦合的类来完成工作）

请允许我先介绍一下我所有的组件：

课程：

标签观察者

Option Explicit

Private WithEvents mInteralObj As MSForms.label
Private mBackGroundColor As Long
Private mMouseOverColor As Long

Private Const clGREY As Long = &H8000000F

'// "Constructor"
Public Sub Init(label As MSForms.label, _
                Optional mouseOverColor As Long = clGREY, _
                Optional backGroundColor As Long = clGREY)
                
    Set mInteralObj = label
    mBackGroundColor = backGroundColor
    mMouseOverColor = mouseOverColor
End Sub

Private Sub Class_Terminate()
    Set mInteralObj = Nothing
End Sub

Public Sub MouseLeft()
    '//Remove Highlight
    mInteralObj.BackColor = mBackGroundColor
End Sub

Private Sub mInteralObj_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '//Highlight
    mInteralObj.BackColor = mMouseOverColor
End Sub

标签通知程序

Option Explicit
Private observersCollection As Collection

Private Sub Class_Initialize()
    Set observersCollection = New Collection
End Sub

Public Sub AddObserver(observer As LabelObserver)
    observersCollection.Add observer
End Sub

Public Sub RemoveObserver(observer As LabelObserver)
    Dim i As Long
    '// We have to search through the collection to find the observer to remove
    For i = 1 To observersCollection.Count
        If observersCollection(i) Is observer Then
            observersCollection.Remove i
            Exit Sub
        End If
    Next i
End Sub

Public Function ObserverCount() As Integer
    ObserverCount = observersCollection.Count
End Function

Public Sub Notify()
    Dim obs As LabelObserver
    
    If Me.ObserverCount > 0 Then
    
        For Each obs In observersCollection
            '//call each observer's MouseLeft method
            obs.MouseLeft
        Next obs
    
    End If
End Sub

Private Sub Class_Terminate()
    Set observersCollection = Nothing
End Sub

模块：

LabelObserverFactory （这有点可选 - 它只是提供了一种很好的简化方式来创建 valid LabelObservers）

Option Explicit

Public Function NewYellowHighlightCustomLabel(label As MSForms.label) As LabelObserver
    Dim product As New LabelObserver
    
    product.Init label, vbYellow
    
    Set NewYellowHighlightCustomLabel = product
End Function

Public Function NewRedHighlightCustomLabel(label As MSForms.label) As LabelObserver
    Dim product As New LabelObserver
    
    product.Init label, vbRed
    
    Set NewRedHighlightCustomLabel = product
End Function

用户窗体

MyForm （请注意，出于本演示的目的，此表单具有三个带有默认名称的标签）

Option Explicit

Private notifier As LabelNotifier


Private Sub UserForm_Initialize()
    Set notifier = New LabelNotifier
    
    '//add controls to be notified
    notifier.AddObserver LabelObserverFactory.NewYellowHighlightCustomLabel(Me.Label1)
    notifier.AddObserver LabelObserverFactory.NewRedHighlightCustomLabel(Me.Label2)
    notifier.AddObserver LabelObserverFactory.NewYellowHighlightCustomLabel(Me.Label3)
    
    
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '//Notify labels that mouse has left them
    notifier.Notify
End Sub

Private Sub UserForm_Terminate()
    Set notifier = Nothing
End Sub

现在，解释一下这里发生了什么：

表单有一个 LabelNotifier 对象，该对象在表单初始化时建立，它将用于通知我们的标签鼠标已经离开它们。我们通过监听表单的 MouseMove 事件来做到这一点。（我知道您正试图避免使用它，但希望我们的代码只有一行代码这一事实，无论您影响多少标签，都能满足将逻辑封装在其他地方的愿望。）当我们移动鼠标时，我们将让通知器做它唯一的工作，向我们添加到它的所有标签发送消息。

LabelObserver 是 LabelNotifier 的对应部分。标签观察者负责告诉标签更改颜色以及使用哪些颜色。

即使你不喜欢这个实现，我也玩得很开心。:-)

于 2020-07-23T18:04:21.147 回答