Как L oop Userform Controls Events?

Question

Мне нужен al oop для событий элементов управления пользовательской формой.

У меня шесть элементов изображения;

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 в al oop.

Answer 1

• 1000 Код функций, как показано ниже;

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, делает l oop каждый раз, когда я заставляю мышь перемещаться по изображению или пользовательской форме.

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 2

Вы можете использовать собственный класс для захвата MouseMove элементов управления, которые вам интересны. Вот простой пример, который просто меняет цвет фона для командных кнопок.

Вашим вариантом использования будет немного более сложный, но тот же базовый c подход будет работать.

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