1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
| Option Explicit
Public Event KeyDownFromObject(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, ObjectSource As Object)
Private WithEvents objCheckBox As MSForms.CheckBox
Private WithEvents objComboBox As MSForms.ComboBox
Private WithEvents objCommandButton As MSForms.CommandButton
Private WithEvents objFrame As MSForms.Frame
Private WithEvents objListBox As MSForms.ListBox
Private WithEvents objMultiPage As MSForms.MultiPage
Private WithEvents objOptionButton As MSForms.OptionButton
Private WithEvents objScrollBar As MSForms.ScrollBar
Private WithEvents objSpinButton As MSForms.SpinButton
Private WithEvents objTabStrip As MSForms.TabStrip
Private WithEvents objTextBox As MSForms.TextBox
Private WithEvents objToggleButton As MSForms.ToggleButton
Private WithEvents objUserForm As MSForms.UserForm
Private collControls As VBA.Collection
Private oParent As Cls_FrmEvents
Public Sub SendKeyDownEvent(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, fromObject As Object)
RaiseEvent KeyDownFromObject(KeyCode, Shift, fromObject)
End Sub
Private Sub objCheckBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objCheckBox: End Sub
Private Sub objComboBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objComboBox: End Sub
Private Sub objCommandButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objCommandButton: End Sub
Private Sub objFrame_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objFrame: End Sub
Private Sub objListBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objListBox: End Sub
Private Sub objMultiPage_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objMultiPage: End Sub
Private Sub objOptionButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objOptionButton: End Sub
Private Sub objScrollBar_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objScrollBar: End Sub
Private Sub objSpinButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objSpinButton: End Sub
Private Sub objTabStrip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objTabStrip: End Sub
Private Sub objTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objTextBox: End Sub
Private Sub objToggleButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objToggleButton: End Sub
Private Sub objUserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer): oParent.SendKeyDownEvent KeyCode, Shift, objUserForm: End Sub
Public Sub InitUserformControls(frm As MSForms.UserForm)
Dim ctrl As MSForms.Control
Dim oCtrl As Cls_FrmEvents
Set collControls = New VBA.Collection
Set oCtrl = New Cls_FrmEvents
If oCtrl.SetCtrl(frm, Me) Then collControls.Add oCtrl
For Each ctrl In frm.Controls
Set oCtrl = New Cls_FrmEvents
If oCtrl.SetCtrl(ctrl, Me) Then collControls.Add oCtrl
Next ctrl
End Sub
Public Function SetCtrl(ctrl As Object, p As Cls_FrmEvents) As Boolean
SetCtrl = True
Set oParent = p
Select Case TypeName(ctrl)
Case "CheckBox": Set objCheckBox = ctrl
Case "ComboBox": Set objComboBox = ctrl
Case "CommandButton": Set objCommandButton = ctrl
Case "Frame": Set objFrame = ctrl
Case "ListBox": Set objListBox = ctrl
Case "MultiPage": Set objMultiPage = ctrl
Case "OptionButton": Set objOptionButton = ctrl
Case "ScrollBar": Set objScrollBar = ctrl
Case "SpinButton": Set objSpinButton = ctrl
Case "TabStrip": Set objTabStrip = ctrl
Case "TextBox": Set objTextBox = ctrl
Case "ToggleButton": Set objToggleButton = ctrl
Case Else
If TypeOf ctrl Is UserForm Then
Set objUserForm = ctrl
Else
SetCtrl = False
End If
End Select
End Function |
Partager