VBA, MS Access MS Access в примерах

Прокрутка записей ленточной формы колесом мыши

По материалам: https://msdn.microsoft.com/en-us/library/office/ff191697.aspx

На событие "Колёсико мышки" формы вешаем код:

Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
'Прокрутка записей ленточной формы колесом мыши
'--------------------------------------------------------------------
Dim iDir As Integer
    Select Case Count
        Case Is < 0: iDir = -1
        Case Else:   iDir = 1
    End Select
    On Error Resume Next 'На случай предела
    Me.Recordset.Move 1 * iDir 'Аргумент = Rows (+ или -)
    Err.Clear
End Sub



Второй вариант
В любом модуле размещаем:

Public Sub MouseWhellInForm(objfrm As Form, ByVal lCount As Long)
'es 05.04.2018 - http://msa.polarcom.ru
'Прокрутка записей ленточной формы колесом мыши
'--------------------------------------------------------------------
Dim iDir As Integer
'Куда - вверх или вниз
    Select Case lCount
        Case Is < 0: iDir = -1
        Case Else:   iDir = 1
    End Select
'Прокрутка
    On Error Resume Next 'На случай предела
    objfrm.Recordset.Move 1 * iDir 'Аргумент = Rows (+ или -)
    Err.Clear
End Sub


В форме пишем:

Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    MouseWhellInForm Me, Count 'Прокрутка записей ленточной формы колесом мыши
End Sub



Ещё аналог:

Public Sub MouseWhellInForm(Count As Long)
'es 26.07.2016 - http://msa.polarcom.ru
'Прокрутка записей ленточной формы колесом мыши
'--------------------------------------------------------------------
    On Error Resume Next
    If Count > 0 Then 'Обработка направления перехода
        DoCmd.GoToRecord , , acNext     ' Прокрутка ВНИЗ
    Else
        DoCmd.GoToRecord , , acPrevious ' Прокрутка ВВЕРХ
    End If
    Err.Clear
End Sub


В форме пишем:

Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    MouseWhellInForm Count 'Прокрутка записей ленточной формы колесом мыши
End Sub




Ещё вариант

По материалам: http://allenbrowne.com/ser-70.html

Public Function DoMouseWheel(frm As Form, lngCount As Long) As Integer
On Error GoTo Err_Handler
    'Purpose:   Make the MouseWheel scroll in Form View in Access 2007 and later.
    '           This code lets Access 2007 behave like older versions.
    'Return:    1 if moved forward a record, -1 if moved back a record, 0 if not moved.
    'Author:    Allen Browne, February 2007.
    'Usage:     In the MouseWheel event procedure of the form:
    '               Call DoMouseWheel(Me, Count)
    Dim strMsg As String
    'Run this only in Access 2007 and later, and only in Form view.
    If (Val(SysCmd(acSysCmdAccessVer)) >= 12#) And (frm.CurrentView = 1) And (lngCount <> 0&) Then
        'Save any edits before moving record.
        RunCommand acCmdSaveRecord
        'Move back a record if Count is negative, otherwise forward.
        RunCommand IIf(lngCount < 0&, acCmdRecordsGoToPrevious, acCmdRecordsGoToNext)
        DoMouseWheel = Sgn(lngCount)
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    Select Case Err.Number
    Case 2046&                 'Can't move before first, after last, etc.
        Beep
    Case 3314&, 2101&, 2115&   'Can't save the current record.
        strMsg = "Cannot scroll to another record, as this one can't be saved."
        MsgBox strMsg, vbInformation, "Cannot scroll"
    Case Else
        strMsg = "Error " & Err.Number & ": " & Err.Description
        MsgBox strMsg, vbInformation, "Cannot scroll"
    End Select
    Resume Exit_Handler
End Function
Назад ToTop
L.E. 21.02.2020
Рейтинг@Mail.ru