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

Question

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

我有六个图像项；

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 事件。

Answer 1

您可以使用自定义类来捕获您感兴趣的控件的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

自定义类hover - 此类的对象持有对提供的控件的引用并捕获其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

Answer 2

在蒂姆·威廉姆斯的帮助下，我完成了。

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

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

而且...大一个:) 类叫 hover 每次让鼠标在图像或用户窗体上移动时都会循环。

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。但它现在对我有用。

Answer 3

使用类中的文本框MouseMove程序，当鼠标光标悬停在文本框上时，我使文本框的背景颜色发生变化。

我在 UserForm 中添加了以下代码：

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