Excel VBA Userformdynamic运行时控件 – 跨多个控件触发相同的类事件

我正在构build基于Excel的应用程序，该应用程序基于外部数据在运行时dynamic构build。

这是空的用户表单：

UserForm_Activate()代码

 Private Sub UserForm_Activate() Dim f As Control, i As Integer mdMenuItems.BuildMenuItems mdTheme.GetTheme For Each f In Me.Controls If TypeName(f) = "Frame" Then i = i + 1 ReDim Preserve fra(1 To i) Set fra(i).fraEvent1 = f End If Next f End Sub 

mdMenuItems.BuildMenuItemsdynamic生成一系列基于外部数据的菜单项…

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.csvinput。 我把这个文件中的每一行分配给i 。 然后我Set三个单独的MSForms.Label （s）：

1. lblMenuBackground
2. lblMenuIcon
3. lblMenuText

…并asynchronous构build它们。

你会注意到，在构build第一个标签（ 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_Activate之后，这里是更新的forms：

（您可能会注意到在这里使用FontAwesome图标。）

因为我已经为每个lblMenuBackground标签添加了一个自定义MouseOver类事件，所以鼠标hover会导致.BackColor更改：

这是我的问题…

只有当光标经过组成每个菜单项目的三个标签中的一个标签时，才会触发该鼠标hover效果。

lblMenuBackground

为什么？

我只知道如何影响被调用控件的属性。

更确切地说…

我不知道如何从被调用的控件的事件中影响未调用的控件属性。

这里是每个菜单项的结构：

这是我的问题

如何影响组成每个菜单项的所有三个单独控件的MouseOver事件中相同控件的.BackColor ？

1. 将光标移动到图标上=背景颜色改变
2. 将光标移动到文本上=背景颜色改变
3. 将光标移到背景上=背景颜色改变

类事件需要在构build时分配…

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

…为每个菜单项目。

End Sub Question

__________

这个逻辑将从根本上为我的界面打下基础。

对于那些到此为止的人 – 感谢您的阅读！

任何帮助表示赞赏。

谢谢，

J先生

Answer 1

您正在连接到lblMenuBackground的事件

lbl（i）.lblEvent1 = lblMenuBackground

修改BuildMenuItems

更改

设置lbl（i）.lblEvent1 = lblMenuBackground

至

设置lbl（i）=新的cMenuItem

lbl（i）.setControls lblMenuBackground，lblMenuIcon，lblMenuText

修改CMenuItem类

 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