MyTetra Share
Делитесь знаниями!
Прокрутка записей ленточной формы колесом мыши
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 06 Формы Подчиненные
Запись: xintrea/mytetra_db_adgaver_new/master/base/15319727397rpj7v1nam/text.html на raw.githubusercontent.com

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

По материалам: 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



Так же в этом разделе:
 
MyTetra Share v.0.59
Яндекс индекс цитирования