Перемещение фокуса по коллекции записей субФормы

' *** Глобальные  
' *** *** *** *** *** *** ***
Public rst As DAO.Recordset
 
Private Sub fNameStud_frm_Change()
        '   Dim frm As Form                     ' Форма
        '   Dim strCriteria As String       ' "Имя поля формы" +  "Критерий".  "Имя поля формы" которая фильтруется. Пример использования ("GoodID = 25")
        '            Dim blToFirst As Boolean     ' К `первой`(`последней`) записи.  blToFirst = False (переход на последнюю запись)
        '
        '            Set frm = Me!tbl_02_Students.Form
        '            ' strCriteria = "NameStud = " & Me.fNameStud_frm
        '              strCriteria = "NameStud  = "
        '             strCriteria = "NameStud Like '*" & Me.fNameStud_frm & "*'"
        '            blToFirst = True ' Переход на первую запись
        '
        '            ' Call SetFormRecord(frm, strCriteria, blToFirst)
End Sub
 
Private Sub fNameStud_frm_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = 13 Then
            Dim frm As Form                     ' Форма
            Dim strCriteria As String       ' "Имя поля формы" +  "Критерий".  "Имя поля формы" которая фильтруется. Пример использования ("GoodID = 25")
            Dim blToFirst As Boolean     ' К `первой`(`последней`) записи.  blToFirst = False (переход на последнюю запись)
            
            Set frm = Me!tbl_02_Students.Form
            ' strCriteria = "NameStud = " & Me.fNameStud_frm
            ' strCriteria = "NameStud  = "
             strCriteria = "NameStud Like '*" & Me.fNameStud_frm.Text & "*'"
            blToFirst = True ' Переход на первую запись
            
           ' Call SetFormRecord(frm, strCriteria, blToFirst)
            Me.fNameStud_frm.SetFocus
            
            ' *** Тест --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
            Test1
            
   End If
End Sub
 
 
 
Public Sub SetFormRecord(frm As Form, Optional strCriteria As String, Optional blToFirst As Boolean = False)
' es 22.11.2004 - 16.12.2017 LE
' http://msa.polarcom.ru/st/s0000115.htm
' Производит поиск записи по заданным критериям в форме(подчиненной форме).
' ***
' Если запись найдена -  ставит фокус на найденную запись;
' Если запись не найдена -  переход на Первую или Последнюю запись;
' Переход Первую или Последнюю запись происходит в зависимости от аргумента - `blToFirst`
' blToFirst = False  - переход на последнюю запись
' По умолчанию  blToFirst = False (переход на последнюю запись)
' Пример использования - см. ссылку вначале.
' ------------------------------------------------------------------------------
On Error GoTo SetFormRecordErr
    With frm
        .RecordsetClone.FindFirst strCriteria
        If .RecordsetClone.NoMatch Then
            If blToFirst = False Then
                .RecordsetClone.MoveLast
            Else
                .RecordsetClone.MoveFirst
            End If
        End If
        .Bookmark = .RecordsetClone.Bookmark
    End With
SetFormRecordBye:
    On Error Resume Next
    Set frm = Nothing
    Exit Sub
SetFormRecordErr:
    Err.Clear
    Resume SetFormRecordBye
End Sub
 
 
' *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
' ***  Тест  ***
' *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
Public Sub Test1()
         Dim nameTable As String
         Dim criteria As String
         Dim nameFieldCriteria As String
          
        nameTable = "tbl_02_Students"
        criteria = "NameStud Like '*" & Me.fNameStud_frm.Text & "*'"
        nameFieldCriteria = "NameStud"
          
        Call GetRecordsByCriteria(nameTable, nameFieldCriteria, criteria)
          
End Sub
 
Public Sub GetRecorsdByCriteria(nameTable As String, nameFieldCriteria As String, criteria As String)
        
         Dim strSQL  As String
                   
        ' Формируем запрос ---  --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
        ' ASC  -  по возрастанию
        ' DESC - по убыванию
         strSQL = "select *" & _
                        " from " & nameTable & _
                        " WHERE " & criteria
 
            
        Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)    ' Открытие на редакцию
        ' Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot) ' Только просмотр
                   
'      'Перебор всех записей в наборе
'        With rst
'            Do Until .EOF = True 'Цикл до конца набора
'                'Тут операции с записью:
'                '…
'                Dim result As String
'               result = .Fields(nameFieldCriteria)
'
'                .MoveNext
'            Loop
'        End With
    
    On Error Resume Next
    rst.Close
    Set rst = Nothing
End Sub
 
 
' Вверх
Private Sub UP_btn_Click()
        Dim result As String
        result = rst.Fields("NameStud")
        rst.MoveNext
End Sub
 
' Вниз
Private Sub Down_btn_Click()
        ' Dim result As String
        ' result = rst.Fields("NameStud")
        ' rst.MoveNext
        Dim rstCur As DAO.Recordset
        Dim i As Integer
        
        Set rstCur = rst
        i = rstCur.RecordCount
        
        With rstCur
                Dim result As String
               result = .Fields("NameStud")
               rst.MoveNext
        End With
End Sub

Sub GotoRec(KeyCode As Integer)
Select Case KeyCode
Case 40:    DoCmd.GoToRecord , , acNext
Case 38:    DoCmd.GoToRecord , , acPrevious
End Select
End Sub
 
Private Sub поле1_KeyDown(KeyCode As Integer, Shift As Integer)
GotoRec (KeyCode)
End Sub
 
Private Sub поле2_KeyDown(KeyCode As Integer, Shift As Integer)
GotoRec (KeyCode)
End Sub

Me.Recordset.FindFirst "NameStud Like ""*" & StrCond & "*"""
 
Me.Recordset.FindNext "NameStud Like ""*" & StrCond & "*"""
 
Me.Recordset.FindPrevious "NameStud Like ""*" & StrCond & "*"""

Private Sub fNameStud_frm_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = 13 Then
        Me.tbl_02_Students.Form.Recordset.FindFirst "NameStud Like ""*" & Me.fNameStud_frm.Text & "*"""
   End If
End Sub
Private Sub UP_btn_Click()
        Me.tbl_02_Students.Form.Recordset.FindPrevious "NameStud Like ""*" & Me.fNameStud_frm.Text & "*"""
End Sub
 
Private Sub Down_btn_Click()
        ' Me.tbl_02_Students.SetFocus
        Me.tbl_02_Students.Form.SetFocus
        Me.tbl_02_Students.Form.Recordset.FindNext "NameStud Like ""*" & Me.fNameStud_frm.Text & "*"""
End Sub

Private Sub Down_btn_Click()
        ' FindNextEx
        FindNextEx1
End Sub
 
Public Sub FindNextEx()
        Froms![frm_03_03_Students_Lent].Form.SetFocus
        Froms![frm_03_03_Students_Lent].Form.Recordset.FindNext "NameStud Like ""*" & Me.fNameStud_frm.Text & "*"""
End Sub
 
Public Sub FindNextEx1()
        Me.frm_03_03_Students_Lent.Form.SetFocus
        Me.frm_03_03_Students_Lent.Form.Recordset.FindNext "NameStud Like ""*" & Me.fNameStud_frm.Text & "*"""
End Sub

Private Sub Down_btn_Click()
  frm_03_03_Students_Lent.Form.Recordset.FindNext "NameStud Like ""*" & Me.fNameStud_frm & "*"""
End Sub
 
Private Sub Up_btn_Click()
  frm_03_03_Students_Lent.Form.Recordset.FindPrevious "NameStud Like ""*" & Me.fNameStud_frm & "*"""
End Sub
 
' ну и для Enter это вставьте куда надо
  frm_03_03_Students_Lent.Form.Recordset.FindFirst "NameStud Like ""*" & Me.fNameStud_frm & "*"""

Private Sub Down_btn_Click()
            FindNextEx2
End Sub
 
Public Sub FindNextEx2()
           frm_03_03_Students_Lent.Form.Recordset.FindNext "NameStud Like ""*" & fNameStud_frm & "*"""          
End Sub