如何循环用户窗体控件事件?

How to Loop Userform Controls Events?

我想要用户窗体控件事件的循环。

我有六个图像项;

button1
button1_hover 
button2 
button2_hover 
button3 
button3_hover

我使用名为 MouseMove 的事件来创建悬停语句。我是这样用这个方法的;

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

button1.Visible = False
button1_hover.Visible = True

End Sub

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

button2.Visible = False
button2_hover.Visible = True

End Sub

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

button3.Visible = False
button3_hover.Visible = True

End Sub

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

For i = 1 To 4
 Me.Controls("button" & i).Visible = True
 Me.Controls("button" & i & "_hover").Visible = False
 Me.Controls("button" & i & "_click").Visible = False
Next

End Sub

它有效,但我想循环使用三个 mousemove 事件。

您可以使用自定义 class 来捕获您感兴趣的控件的 MouseMove。这是一个简单的示例,它只是将命令按钮的背景色换掉。

您的用例会稍微复杂一些,但基本方法相同。

Option Explicit

Private colButtons As Collection

Private Sub UserForm_Activate()
    Dim ctl
    Set colButtons = New Collection
    'loop over controls and look for buttons (for example)
    For Each ctl In Me.Controls
        If TypeName(ctl) = "CommandButton" Then
            colButtons.Add getHover(ctl) 'create an instance of hover using ctl
        End If
    Next
End Sub

Function getHover(ctl)
    Dim rv As New hover
    Set rv.btn = ctl
    Set getHover = rv
End Function

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Dim o As hover
    'clear all the button backcolors in colButtons
    For Each o In colButtons
        o.btn.BackColor = RGB(200, 200, 200)
    Next o
End Sub

自定义 class hover - 此 class 的对象持有对所提供控件的引用并捕获其 MouseMove 事件

Option Explicit

Public WithEvents btn As MSForms.CommandButton '<< note WithEvents

Private Sub btn_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                          ByVal X As Single, ByVal Y As Single)
    btn.BackColor = vbYellow
End Sub

在 Tim Williams 的帮助下我完成了它。

在用户表单中代码看起来像;

Option Explicit


Private Sub UserForm_Activate()
    Set userform_index = Me '' I set user form item to call it another module
    Call Functions.Button_Hover
End Sub

我还创建了名为 Functions 的模块。函数代码如下;

Option Explicit
Public col_button As Collection
Public userform_index As UserForm
Public temp_ctl
Sub Run()
Main_Page.Show
End Sub
Function Button_Hover()
           Set col_button = New Collection '' Crate a collection which carry item in it.
            For Each temp_ctl In userform_index.Controls '' Checking every toolbox item in exist userform
                If Len(temp_ctl.Name) = 7 And TypeName(temp_ctl) = "Image" Then
                '' ^^I have image called button1 also button1_hover. I sparate that with it. (takes only button1)^^
                    col_button.Add getHover(temp_ctl) '' used interested image in function called gethover
                End If
            Next
            col_button.Add getHover(userform_index) '' used userform in gethover function
End Function
Private Function getHover(temp_ctl) '' this func set hover as image or userform.
    Dim temp_hover As New hover
    
    If TypeName(temp_ctl) = "Image" Then
     Set temp_hover.btnimg = temp_ctl
     
    Else
     Set temp_hover.btnform = temp_ctl
     
    End If
    
     Set getHover = temp_hover
     
End Function

还有...大一个 :) class 每次都让鼠标悬停在图像或用户窗体上移动时循环。

Option Explicit
Public WithEvents btnimg As MSForms.Image
Public WithEvents btnform As MSForms.UserForm
Public button_index As Integer
Public button_count As Integer

Sub btnimg_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    button_index = Right(btnimg.Name, 1) ''gettin button index as i did. (Exp: button1 to 1)
    button_count = (col_button.Count) - 1 '' gettin button count decrease userform.
    userform_index.Controls("button" & button_index).Visible = False '' (Exp: button1.visible =false)
    userform_index.Controls("button" & button_index & "_hover").Visible = True '(Exp: button1_hover.visible =True)
   
End Sub

Sub btnform_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    button_count = (col_button.Count) - 1
    For button_index = 1 To button_count '' Set all button with no hover visible and make hovers invisible.
        userform_index.Controls("button" & button_index).Visible = True
        userform_index.Controls("button" & button_index & "_hover").Visible = False
    Next
    
End Sub

最终结果;

它工作正常,但我需要更新超过 9 个按钮 :D。但它现在对我有用。

使用 a class 中的文本框 MouseMove 程序,当鼠标光标悬停在文本框上时,我改变了文本框的背景颜色。

我在用户窗体中添加了以下代码:

Dim excelvba() As New Alltextboxes
Dim say As Integer, evn As Control
Private Sub UserForm_Initialize()
    say = 1
    For Each evn In Me.Controls
      If TypeName(evn) = "TextBox" Then
         ReDim Preserve excelvba(1 To say)
         Set excelvba(say).TextGroup = evn
         say = say + 1
       End If
    Next
End Sub

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

    For Each evn In Me.Controls
      If TypeName(evn) = "TextBox" Then
         evn.BackColor = vbWhite
      End If
    Next evn
End Sub

Source of sample file