اخفاء اشرطة التمرير والتمرير من خلال عجلة الماوس ( الفأرة )

[Radwan0]

السلام عليكم

اخواني قمت في إزالة Scroll bar من النموذج ولكن أريد أن أقوم بتحريك البيانات للأعلى والأسفل عن طريق عجلة الماوس الوسطى فقط

 

[ابو جودي]

ضع الكود الاتى فى موديول 

Public Function DoMouseWheel(frm As Form, lngCount As Long) As Integer

Dim strMsg As String
  If (Val(SysCmd(acSysCmdAccessVer)) >= 12#) And (frm.CurrentView = 1) And (lngCount <> 0&) Then
    RunCommand acCmdSaveRecord
    RunCommand IIf(lngCount < 0&, acCmdRecordsGoToPrevious, acCmdRecordsGoToNext)
    DoMouseWheel = Sgn(lngCount)
  End If
DoCmd.CancelEvent
Response = False

End Function

ثم فى النموذج فى حدث On Mouse Wheel ضع السطر التالى

  Call DoMouseWheel(Me, Count)

 

[Moosak]

في ٢٩‏/١٠‏/٢٠٢١ at 14:19, ابو جودي said:

ضع الكود الاتى فى موديول 

Public Function DoMouseWheel(frm As Form, lngCount As Long) As Integer

Dim strMsg As String
  If (Val(SysCmd(acSysCmdAccessVer)) >= 12#) And (frm.CurrentView = 1) And (lngCount <> 0&) Then
    RunCommand acCmdSaveRecord
    RunCommand IIf(lngCount < 0&, acCmdRecordsGoToPrevious, acCmdRecordsGoToNext)
    DoMouseWheel = Sgn(lngCount)
  End If
DoCmd.CancelEvent
Response = False

End Function

ثم فى النموذج فى حدث On Mouse Wheel ضع السطر التالى

  Call DoMouseWheel(Me, Count)

 

أستاذنا العزيز @ابو جودي 

أحسن الله إليك ، احتجت لهذا الكود في أحد قواعد البيانات اللي شغال عليها ..😊

لكن عند التشغيل تظهر لي رسالة بأن هذا المتغير غير معرف :

Response = False

كيف يتم تعريفه لكي يعمل الكود ؟ 

وكذلك تظهر رسائل خطأ عندما تكون أول السجلات ويحاول الكود بأن يذهب للسجل السابق بالأمر : acCmdRecordsGoToPrevious

لكنها تختفي مع On Error Resume Next

[ابو جودي]

ضع الكود الاتى فى موديول  

Public Function DoMouseWheel(frm As Form, lngCount As Long) As Integer
On Error GoTo Err_Handler
    Dim strMsg As String
    If (Val(SysCmd(acSysCmdAccessVer)) >= 12#) And (frm.CurrentView = 1) And (lngCount <> 0&) Then
        RunCommand acCmdSaveRecord
        RunCommand IIf(lngCount < 0&, acCmdRecordsGoToPrevious, acCmdRecordsGoToNext)
        DoMouseWheel = Sgn(lngCount)
    End If
Exit_Handler:
    Exit Function
Err_Handler:
    Select Case Err.Number
    Case 2046&
    Resume Next
    Case 3314&, 2101&, 2115&
        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

ثم فى النموذج فى حدث On Mouse Wheel ضع السطر التالى

    Call DoMouseWheel(Me, Count)

 

[Moosak]

في ٢٤‏/١٢‏/٢٠٢١ at 04:06, ابو جودي said:

ضع الكود الاتى فى موديول  

Public Function DoMouseWheel(frm As Form, lngCount As Long) As Integer
On Error GoTo Err_Handler
    Dim strMsg As String
    If (Val(SysCmd(acSysCmdAccessVer)) >= 12#) And (frm.CurrentView = 1) And (lngCount <> 0&) Then
        RunCommand acCmdSaveRecord
        RunCommand IIf(lngCount < 0&, acCmdRecordsGoToPrevious, acCmdRecordsGoToNext)
        DoMouseWheel = Sgn(lngCount)
    End If
Exit_Handler:
    Exit Function
Err_Handler:
    Select Case Err.Number
    Case 2046&
    Resume Next
    Case 3314&, 2101&, 2115&
        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

ثم فى النموذج فى حدث On Mouse Wheel ضع السطر التالى

    Call DoMouseWheel(Me, Count)

 

إشتغلت أحسن وأحلى من العسل 😊👌🏼

ربنا يديك تلاته مليون جنيه ياشيخ 😄

@ابو جودي

وياريت لو يختارها الأستاذ @RaDwAn00 كأفضل إجابة 🙂