كود تفعيل عجلة الماوس في الليست بوكس

Elsayed A Eldiasty · مايو 28, 2021

محتاج كود تفعيل عجلة الماوس في الليست بوكس؟

**أحمد يوسف** · مايو 29, 2021

طالما انك لم تقم برفع ملف ... فكان عليك استخدام خاصية البحث بالمنتدى -تفضل

هل يمكن تفعيل عجلة الماوس داخل الفريم

وهذا كود أخر يمكنك استخدامه

أكواد اليوزرفورم

Option Explicit
Private Sub UserForm_Activate()
    WheelHook Me 'For scrolling support
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
WheelUnHook     'For scrolling support
End Sub
Private Sub UserForm_Deactivate()
WheelUnHook     'For scrolling support
End Sub
Public Sub MouseWheel(ByVal Rotation As Long)
If Rotation > 0 Then
    'Scroll up
    If ListBox1.TopIndex > 0 Then
        If ListBox1.TopIndex > 3 Then
            ListBox1.TopIndex = ListBox1.TopIndex - 3
        Else
            ListBox1.TopIndex = 0
        End If
    End If
Else
    'Scroll down
    ListBox1.TopIndex = ListBox1.TopIndex + 3
End If
End Sub

ووضع هذا الكود فى مديول عادى

'https://www.mrexcel.com/board/threads/listbox-mouse-scroll.459781/
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
      (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim myForm As UserForm
Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'To handle mouse events
    Dim MouseKeys As Long
    Dim Rotation As Long
        If Lmsg = WM_MOUSEWHEEL Then
        MouseKeys = wParam And 65535
        Rotation = wParam / 65536
        'My Form s MouseWheel function
        UserForm1.MouseWheel Rotation
    End If
    WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam)
End Function