Прокрутка записей ленточной формы колесом мышиПо материалам: 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 |
|||
L.E. 21.02.2020 |