Как в табличной форме узнать код верхней видимой строки,

Option Compare Database
Option Explicit

Public Function RequeryPro(frm As Form, ctrlКлюч As Control, Optional blnОтключитьЭхо As Boolean = True, Optional lngВысотаОблЗаг As Long = 270)
'ОСОБЕННОСТИ ОБНОВЛЕНИЯ ТАБЛИЧНОЙ ФОРМЫ
'lngВысотаОблЗаг - высота области заголовков в таблице. По умолчанию
'она равна 270, что расчитано на шрифт Arial Cyr высотой 10. Функция
'может правильно работать и при других шрифтах в таблице, но если все же
'функция будет не точно позиционировать строку в режиме таблицы, подберите это значение
'самостоятельно под конкретный шрифт в таблице, путем опроса значения
'свойства формы CurrentSectionTop, находясь на первой строке в табл.форме

'ОСОБЕННОСТИ ОБНОВЛЕНИЯ ЛЕНТОЧНОЙ ФОРМЫ
'Функция позиционирует строку точно в 95% случаев, в 5% может просчитаться
'на строку. Это может произойти в случае если высота строки лент.формы
'невелика и высота заголовка формы тоже мала. Чтобы добится нормальной
'работы функции в этом случае увеличьте высоту заголовка формы


Dim intCurrTopLast As Integer
Dim intDetailHeight As Integer
Dim intHeaderHeight As Integer
Dim intНомерСтрСверху As Integer  'номер строки в экране.(не абсолютный, а в экране!)
Dim intI As Integer
Dim lngCurrRec As Long
Dim intРазница As Integer
Dim objParent As Object
Dim ctrlАктив As Control
Dim ctrl As Control
Dim strКлюч As String
Dim blnКлючVisible As Boolean
Dim lngSelStart As Long
Dim lngSelLength As Long
Dim varВозврат As Variant

On Error GoTo Err_RequeryPro
    If blnОтключитьЭхо Then
        Application.Echo False
    End If
    On Error Resume Next
    'Проверка на то, чтобы указанная форма имела фокус
    Set objParent = Screen.ActiveControl
    If Err <> 0 Then
        'Нет активного контрола, в этом случае сложно
        'проверить установлен ли фокус на нужную форму/подформу
        'действуем надеясь, что фокус все-таки установлен правильно
        Err = 0
    Else
        Do While Not objParent Is Nothing
            Set objParent = objParent.Parent
            If Err = 0 Then
                If objParent Is frm Then Exit Do
            Else
                Err = 0
                'Функция не сможет выполнить свою функцию :)
                MsgBox "Для вызова функции " & "RequeryPro необходимо предварительно установить фокус на форму " & frm.Name, vbCritical, "Сообщение для разработчика"
                Exit Do
            End If
        Loop
    End If
    Set ctrlАктив = Screen.ActiveControl
    'Контрол ctrlАктив в области данных
    If (TypeOf ctrlАктив Is TextBox) Or (TypeOf ctrlАктив Is ComboBox) Then
        lngSelStart = ctrlАктив.SelStart
        lngSelLength = ctrlАктив.SelLength
    End If
    Err = 0
    'Установим фокус на любой контрол в области данных
    varВозврат = frm.Section(acDetail).Controls(ctrlАктив.Name).Name
    If Err <> 0 Then
        'Активный контрол не в области данных
        Err = 0
        For Each ctrl In frm.Section(acDetail).Controls
            ctrl.SetFocus
            If Err = 0 Then
                Exit For
            Else
                Err = 0
            End If
        Next ctrl
    End If
    On Error GoTo Err_RequeryPro
    If frm.NewRecord Or (frm.NewRecord = False And frm.CurrentRecord = 0) Then
        If frm.CurrentRecord <= 1 Then
            'Записей нет, просто обновим форму
            frm.Requery
        End If
        DoCmd.GoToRecord acActiveDataObject, , acPrevious
    End If
    If frm.CurrentView = 2 Then
        'Это таблица
        intHeaderHeight = lngВысотаОблЗаг
    Else
        intHeaderHeight = frm.Section(acHeader).Height
    End If
    
    'Запомним значение ключа и сделаем поле видимым
    strКлюч = ctrlКлюч.Value
    blnКлючVisible = ctrlКлюч.Visible
    ctrlКлюч.Visible = True
    
    intCurrTopLast = frm.CurrentSectionTop
    'Вычислим intНомерСтрСверху - номер строки в экране
        If intCurrTopLast <> 0 Then
            If frm.CurrentRecord <> 1 Then
                DoCmd.GoToRecord acActiveDataObject, , acPrevious
            End If
            intDetailHeight = intCurrTopLast - frm.CurrentSectionTop
            If intDetailHeight = 0 Then
                intНомерСтрСверху = 1
            Else
                intНомерСтрСверху = Int(Abs((intCurrTopLast - intHeaderHeight) / intDetailHeight)) + 1
            End If
        Else
            intНомерСтрСверху = 1
        End If
    'Обновим форму
    frm.Requery
    'Выберем все записи, перейдя на последнюю
    DoCmd.GoToRecord acActiveDataObject, , acLast  'Нужно в adp
    DoCmd.GoToRecord acActiveDataObject, , acFirst
    'Выйдем на нужную запись
    DoCmd.FindRecord strКлюч, acEntire, False, acSearchAll, False, acCurrent, True
    'Прокрутим экран так, чтоб он занял тоже положение, что имел до обновления
        lngCurrRec = frm.CurrentRecord
        SendKeys "{PGDN}", True
        intРазница = frm.CurrentRecord - lngCurrRec - 1
        For intI = 1 To intНомерСтрСверху + intРазница
            DoCmd.GoToRecord acActiveDataObject, , acPrevious
        Next
        For intI = 1 To intНомерСтрСверху - 1
            DoCmd.GoToRecord acActiveDataObject, , acNext
        Next
    'Вернем фокус на контрол, который его имел до обновления
    ctrlАктив.SetFocus
    ctrlКлюч.Visible = blnКлючVisible
    If (TypeOf ctrlАктив Is TextBox) Or (TypeOf ctrlАктив Is ComboBox) Then
        ctrlАктив.SelStart = lngSelStart
        ctrlАктив.SelLength = lngSelLength
    End If
    If blnОтключитьЭхо Then
        Application.Echo True
    End If
    Exit Function
Err_RequeryPro:
    Application.Echo True
End Function

OPTION EXPLICIT

PRIVATE prMinCode as long

public function ScanCode(ID as long) as string
   if (prMinCode=0) or (prMinCode>ID) then
     prMinCode=ID
   end if
   ScanCode=""
end function

' ЭТО вернет код верхней строки
public function TopRowCode() аs long
   TopRowCode=prMinCode
end function