Циклическое перемещение по значениям поля со списком (ListBox) и обработка нажатий клавиш.
Данная процедура "вешается" на событие "Клаваша вниз" поля со списком.
В данном примере рассмотрен случай когда форма не несет на себе ничего кроме самого списка.
То есть, это некое меню - единственным предназначением которого служит выбор одного значения из нескольких.
Работает это так:
Если пользователь находится на самом нижнем элементе списка и нажимет клавишу ВНИЗ - то тут же оказывается на первом элементе списка, и наоборот, если на самом верхнем нажимет клавишу ВВЕРХ - то оказывается на последнем.
... а при нажатии ENTER - программа принимает значение выбранное в списке, закрывает форму и делает то что положено при выборе данного значения.
Private Sub lstTypeSID_KeyDown(KeyCode As Integer, Shift As Integer)
Dim crlListBox As ListBox
On Error GoTo ListBoxKeyDown_Err
Set crlListBox = Me!lstTypeSID
Select Case KeyCode
Case vbKeyUp
If crlListBox.ListIndex = 0 Then
KeyCode = 0
crlListBox.ListIndex = Me!lstTypeSID.ListCount - 1
End If
Case vbKeyDown
If crlListBox.ListIndex = crlListBox.ListCount - 1 Then
KeyCode = 0
crlListBox.ListIndex = 0
End If
Case vbKeyReturn
Set crlListBox = Nothing
End Select
ListBoxKeyDown_Bye:
Set crlListBox = Nothing
Exit Sub
ListBoxKeyDown_Err:
Debug.Print Err.Description
Err.Clear
KeyCode = 0
Resume ListBoxKeyDown_Bye
End Sub
Private Sub lstTypeSID_DblClick(Cancel As Integer)
cmdSave_Click
End Sub
Ещё вариант:
Private Sub lstInterface_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ctrlListBox As ListBox
Dim lLCount&
On Error GoTo lstInterface_KeyDown_Err
Set ctrlListBox = Me!lstInterface
lLCount = ctrlListBox.ListCount
Select Case KeyCode
Case vbKeyUp
If ctrlListBox.ListIndex = 0 Then
KeyCode = 0
ctrlListBox.ListIndex = lLCount - 1
End If
Case vbKeyDown
If ctrlListBox.ListIndex = lLCount - 1 Then
KeyCode = 0
ctrlListBox.ListIndex = 0
End If
Case vbKeyReturn
Set ctrlListBox = Nothing
cmdAdd_Click
End Select
lstInterface_KeyDown_End:
On Error Resume Next
Set ctrlListBox = Nothing
Err.Clear
Exit Sub
lstInterface_KeyDown_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub lstInterface_KeyDown.", vbCritical, "Произошла ошибка!"
Err.Clear
Resume lstInterface_KeyDown_End
End Sub
|