Excel VBA Userform动态运行时控件-跨多个控件触发同一类事件_Excel_Vba_Dynamic_User Controls_Runtime

Excel VBA Userform动态运行时控件-跨多个控件触发同一类事件

excel vba dynamic

Excel VBA Userform动态运行时控件-跨多个控件触发同一类事件,excel,vba,dynamic,user-controls,runtime,Excel,Vba,Dynamic,User Controls,Runtime,我正在构建一个基于Excel的应用程序，该应用程序在运行时根据外部数据动态构建自身以下是空的用户表单： UserForm\u Activate（）中的代码 mdMenuItems.BuildMenuItems基于外部数据动态构建一系列菜单项 mdMenuItems模块中的代码 Option Explicit Dim lbl() As New cMenuItem Public myFileData As String Public myFileValue As String Public fr

我正在构建一个基于Excel的应用程序，该应用程序在运行时根据外部数据动态构建自身

以下是空的用户表单：

UserForm\u Activate（）中的代码
mdMenuItems.BuildMenuItems
基于外部数据动态构建一系列菜单项
mdMenuItems模块中的代码
Option Explicit
Dim lbl() As New cMenuItem
Public myFileData As String
Public myFileValue As String
Public frmTheme As String

Sub BuildMenuItems()
Dim FileNum As Integer, i As Integer
Dim WrdArray() As String
Dim lblMenuIcon As MSForms.Label, lblMenuText As MSForms.Label, lblMenuBackground As MSForms.Label

FileNum = FreeFile()

Open Application.ThisWorkbook.Path & "\Data\MenuItems.csv" For Input As #FileNum

Do While Not EOF(FileNum)
    i = i + 1
    Line Input #FileNum, myFileData ' read in data 1 line at a time
    WrdArray() = Split(myFileData, ",")
    Set lblMenuBackground =  frmTest.frmMenuBackground.Controls.Add("Forms.Label.1", "lblMenuBackground_" & i)
    Set lblMenuIcon = frmTest.frmMenuBackground.Controls.Add("Forms.Label.1", "lblMenuIcon_" & i)
    Set lblMenuText = frmTest.frmMenuBackground.Controls.Add("Forms.Label.1", "lblMenuText_" & i)

    With lblMenuBackground
        .top = 30 * i
        .left = 0
        .Width = 170
        .Height = 30
        .BackColor = RGB(255, 255, 255)
        .BackStyle = fmBackStyleOpaque
        .MousePointer = fmMousePointerCustom
        .MouseIcon = LoadPicture(Application.ThisWorkbook.Path & "\Creative\Other\Hand.cur")
        .Tag = "_006"
    End With

    ReDim Preserve lbl(1 To i)
    Set lbl(i).lblEvent1 = lblMenuBackground

    With lblMenuIcon
        .Caption = Sheets("FontAwesome").Cells(WrdArray(0), 1)
        .top = (30 * i) + 9
        .left = 0
        .Width = 30
        .Height = 20
        .ForeColor = RGB(0, 0, 0)
        .BackStyle = fmBackStyleTransparent
        .Font.Name = "FontAwesome"
        .Font.Size = 14
        .TextAlign = fmTextAlignCenter
        .MousePointer = fmMousePointerCustom
        .MouseIcon = LoadPicture(Application.ThisWorkbook.Path & "\Creative\Other\Hand.cur")
        .Tag = "-021"
    End With

    With lblMenuText
        .Caption = WrdArray(1)
        .top = (30 * i) + 8
        .left = 30
        .Width = 90
        .Height = 20
        .ForeColor = RGB(0, 0, 0)
        .BackStyle = fmBackStyleTransparent
        .Font.Size = 12
        .MousePointer = fmMousePointerCustom
        .MouseIcon = LoadPicture(Application.ThisWorkbook.Path & "\Creative\Other\Hand.cur")
        .Tag = "-021"
    End With

Loop

Close #FileNum

End Sub

好的，简要介绍一下这里发生了什么
我打开一个数据文件MenuItems.csv
进行输入。我将此文件中的每一行分配给I
。然后，我设置三个单独的MSForms.Label
：
lblMenuBackground
lblMenuIcon
lblMenuText
…并异步构建它们
您会注意到，在构建第一个标签（lblMenuBackground
）之后，我分配了一个自定义类事件lbl（I）.lblEvent1=lblMenuBackground

（这里正确使用ReDim Preserve
非常重要，这样每个顺序菜单项都可以获得这个自定义类，而不仅仅是最后一个。）
cMenuItem类模块中的代码
Public WithEvents lblEvent1 As MSForms.Label

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

Dim ctl As Control
    For Each ctl In frmTest.frmMenuBackground.Controls
        If TypeName(ctl) = "Label" Then
            If Not ctl.BackColor = RGB(GetB(mdTheme.frmThemeID6), GetG(mdTheme.frmThemeID6), GetR(mdTheme.frmThemeID6)) Then ctl.BackColor = RGB(GetB(mdTheme.frmThemeID6), GetG(mdTheme.frmThemeID6), GetR(mdTheme.frmThemeID6))
        End If
    Next ctl

Me.lblEvent1.BackColor = RGB(GetB(mdTheme.frmThemeID2), GetG(mdTheme.frmThemeID2), GetR(mdTheme.frmThemeID2))

End Sub

（请忽略此处的.BackColor
属性复杂性，因为它可能会变得更加混乱，并且与此问题无关。）
UserForm\u激活后
，以下是更新后的表单：

（您可能会注意到此处使用的图标。）
由于我已将自定义的MouseOver
类事件添加到每个lblMenuBackground
标签，因此鼠标悬停会导致.BackColor
更改：

这是我的问题。。。
只有当光标经过构成每个菜单项的三个标签之一时，才会触发此鼠标悬停效果
lblMenuBackground

为什么？
我只知道如何影响被调用控件的属性
或者更确切地说
我不知道如何从被调用控件的事件中影响未调用的控件属性
以下是每个菜单项的结构：

这是我的问题。。。

如何通过构成每个菜单项的所有三个单独控件的鼠标上方事件影响同一控件的.BackColor

将光标移到图标上=背景颜色更改
将光标移到文本上=背景颜色更改
将光标移到背景上=背景颜色更改
类事件需要在生成时分配
…对于每个菜单项
结束
Sub问题

__________
这种逻辑将从根本上为我的接口奠定基础
对于那些走到今天的人，谢谢你们的阅读
感谢您的帮助
谢谢
J先生
您正在与lblMenuBackground

lbl（i）.lblEvent1=lblMenuBackground
修改BuildMenuItems
改变
设置lbl（i）.lblEvent1=lblMenuBackground
到
设置lbl（i）=新项目
lbl（i）.设置控制lblMenuBackground、lblMenuIcon、lblMenuText
修改CMenuItem类
谢谢你的评论，我喜欢你的评论！我得到了一个编译错误，请看我上面的编辑…@J先生我更新了我的答案。我对班级也做了一个小小的改变。绝对完美！正是我想要的，谢谢好心的先生：）谢谢，我正在慢慢地为统计分析和报告构建一个主题界面：）@J先生，非常好。我想我应该使用另一个自定义类cMenuItems
来保存cMenuItem
的集合。新的cMenuItems
类将跟踪活动的cMenuItem组。这样，只有以前的活动组和新的活动组将被重新格式化，如果活动组mouseover事件重新触发，则不必重新格式化任何内容。
Public WithEvents lblEvent1 As MSForms.Label

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

Dim ctl As Control
    For Each ctl In frmTest.frmMenuBackground.Controls
        If TypeName(ctl) = "Label" Then
            If Not ctl.BackColor = RGB(GetB(mdTheme.frmThemeID6), GetG(mdTheme.frmThemeID6), GetR(mdTheme.frmThemeID6)) Then ctl.BackColor = RGB(GetB(mdTheme.frmThemeID6), GetG(mdTheme.frmThemeID6), GetR(mdTheme.frmThemeID6))
        End If
    Next ctl

Me.lblEvent1.BackColor = RGB(GetB(mdTheme.frmThemeID2), GetG(mdTheme.frmThemeID2), GetR(mdTheme.frmThemeID2))

End Sub

ReDim Preserve lbl(1 To i)
Set lbl(i).lblEvent1 = lblMenuBackground

Public WithEvents m_lblMenuBackground As MSForms.Label
Public WithEvents m_lblMenuIcon As MSForms.Label
Public WithEvents m_lblMenuText As MSForms.Label

Public Sub setControls(lblMenuBackground As MSForms.Label, lblMenuIcon As MSForms.Label, lblMenuText As MSForms.Label)
    Set m_lblMenuBackground = lblMenuBackground
    Set m_lblMenuIcon = lblMenuIcon
    Set m_lblMenuText = lblMenuText
End Sub
    
Private Sub m_lblMenuBackground_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Update
End Sub

Private Sub m_lblMenuIcon_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Update
End Sub

Private Sub m_lblMenuText_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Update
End Sub

Private Sub Update()
    Dim ctl As Control
    For Each ctl In frmTest.frmMenuBackground.Controls
        If TypeName(ctl) = "Label" Then
            If Not ctl.BackColor = RGB(GetB(mdTheme.frmThemeID6), GetG(mdTheme.frmThemeID6), GetR(mdTheme.frmThemeID6)) Then ctl.BackColor = RGB(GetB(mdTheme.frmThemeID6), GetG(mdTheme.frmThemeID6), GetR(mdTheme.frmThemeID6))
        End If
    Next ctl

    Me.m_lblMenuBackground.BackColor = RGB(GetB(mdTheme.frmThemeID2), GetG(mdTheme.frmThemeID2), GetR(mdTheme.frmThemeID2))
End Sub