这是我的问题......

Question

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

这是空的用户形式：

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.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。然后我Set三个人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_Activate之后，这是更新后的表单：

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

由于我已为每个MouseOver标签添加了自定义lblMenuBackground类事件，因此鼠标悬停导致.BackColor更改：

这是我的问题......

仅当光标经过构成每个菜单项的三个标签之一时，才会触发此鼠标悬停效果。

lblMenuBackground

为什么？

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

或者更确切地说......

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

以下是每个菜单项的结构：

这是我的问题......

如何从构成每个菜单项的所有三个控件的.BackColor事件中影响同一控件的MouseOver？

将光标移到图标=背景颜色更改
将光标移到文本上=背景颜色更改
将光标移到背景上=背景颜色更改

需要在构建时分配类事件...

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

...对于每个菜单项。

End 子 Question

__________

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

对于那些做到这一点的人 - 谢谢你的阅读！

感谢任何帮助。

谢谢，

先生。 Ĵ

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

Excel VBA用户表单动态运行时控件 - 跨多个控件触发相同的类事件

这是我的问题......

为什么？

这是我的问题......

__________

1 个答案:

修改BuildMenuItems

修改CMenuItem类