Klassenmodul MouseMove-Event aller Controls im UF
11.10.2018 09:25:23
Mike
ich habe mir eine Klassenmodul geschrieben, mit dem ich für alle Controls meines Userforms die MouseMove Ereignisse abfangen möchte. Leider funktioniert es nicht. Ich tappe da echt im Dunkeln woran es liegen könnte, ob es im Klassenmodul das RaiseEvent MouseMove ist, oder im Userform der Haken liegt. Wäre super, wenn sich das jemand mal anschauen könnte.
Klassenmodul: cls_FormCtrl_MM
Option Explicit
Public WithEvents F_TB As MSForms.TextBox
Public WithEvents F_Image As MSForms.Image
Public WithEvents F_Label As MSForms.Label
Public WithEvents F_Frame As MSForms.Frame
Public WithEvents F_CBox As MSForms.ComboBox
Public WithEvents F_CBttn As MSForms.CommandButton
Public WithEvents F_OBttn As MSForms.OptionButton
Public WithEvents F_MP As MSForms.MultiPage
Dim F_Ctrl As MSForms.Control
Public Event MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, _
ByVal Y As Single)
Property Get Name() As String
100 Name = F_Ctrl.Name
End Property
Property Get FormControl() As MSForms.Control
100 Set FormControl = F_Ctrl
End Property
Property Set FormControl(Ctrl As MSForms.Control)
100 Set F_Ctrl = Ctrl
101 Select Case TypeName(F_Ctrl)
Case "TextBox"
102 Set Me.F_TB = F_Ctrl
103 Case "Image"
104 Set Me.F_Image = F_Ctrl
105 Case "Label"
106 Set Me.F_Label = F_Ctrl
107 Case "Frame"
108 Set Me.F_Frame = F_Ctrl
109 Case "ComboBox"
110 Set Me.F_CBox = F_Ctrl
111 Case "CommandButton"
112 Set Me.F_CBttn = F_Ctrl
113 Case "OptionButton"
114 Set Me.F_OBttn = F_Ctrl
115 Case "MultiPage"
116 Set Me.F_MP = F_Ctrl
117 End Select
End Property
Private Sub F_Label_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
100 Set FormControl = ActiveCtrl(F_Ctrl)
101 RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Function ActiveCtrl(Container As Object) As MSForms.Control
100 Select Case TypeName(Container)
Case "Frame"
101 If Container.ActiveControl Is Nothing Then
102 Set ActiveCtrl = Container
103 Else
104 Set ActiveCtrl = ActiveCtrl(Container.ActiveControl)
105 End If
106 Case "MultiPage"
107 With Container
108 With .Pages(.Value)
109 If .ActiveControl Is Nothing Then
110 Set ActiveCtrl = Container
111 Else
112 Set ActiveCtrl = ActiveCtrl(.ActiveControl)
113 End If
114 End With
115 End With
116 Case "Page"
117 If Container.ActiveControl Is Nothing Then
118 Set ActiveCtrl = Container.Parent
119 Else
120 Set ActiveCtrl = ActiveCtrl(Container.ActiveControl)
121 End If
122 Case Else
'Container ist gleich Userform
123 If Container.Name = TypeName(Container) Then
124 If Container.ActiveControl Is Nothing Then
125 Set ActiveCtrl = Nothing
126 Else
127 Set ActiveCtrl = ActiveCtrl(Container.ActiveControl)
128 End If
129 Else
130 'Container ist gleich Control
131 Set ActiveCtrl = Container
132 End If
133 End Select
End Function
Private Sub Class_Terminate()
100 Set F_TB = Nothing
101 Set F_Image = Nothing
102 Set F_Label = Nothing
103 Set F_Frame = Nothing
104 Set F_CBox = Nothing
105 Set F_CBttn = Nothing
106 Set F_OBttn = Nothing
107 Set F_MP = Nothing
End Sub
Userform
Option Explicit
Public WithEvents FormControl As cls_FormCtrl_MM
Dim MM_Coll As Collection
Private Sub UserForm_Initialize()
100 Dim Temp_Ctrl As cls_FormCtrl_MM
101 Dim Ctrl As Control
102 Dim P_Ctrl As Variant
103 Dim Z1 As Integer
104 Set MM_Coll = New Collection
105 For Each Ctrl In Me.Controls
106 If Ctrl.Name = "Form_MultiPage" Then
107 For Z1 = 0 To Ctrl.Pages.Count - 1
108 For Each P_Ctrl In Ctrl.Pages(Z1).Controls
109 Set Temp_Ctrl = New cls_FormCtrl_MM
110 Set Temp_Ctrl.FormControl = P_Ctrl
111 MM_Coll.Add Item:=Temp_Ctrl, Key:=P_Ctrl.Name
112 Next
113 Next
114 End If
115 Next
116 Set Temp_Ctrl = Nothing
End Sub
Private Sub FormControl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
100 Debug.Print "Test"
End Sub
Vielen Dank!Viele Grüße
Mike