پرفروش ترين
برترين
آخرين محصولات فروشگاه
فایل الکترونیکی آموزش اکسل پیشرفته ۲۰۱۰
آموزش ایجاد فایل چندکاربره با سطح دسترسی مشخص
نمایش نتایج: از شماره 1 تا 4 , از مجموع 4

موضوع: استفاده از غلتک ماوس برای تغییر cobobox

  1. #1


    آخرین بازدید
    2020/11/02
    تاریخ عضویت
    October 2010
    محل سکونت
    قائمشهر
    نوشته ها
    114
    امتیاز
    54
    سپاس
    150
    سپاس شده
    53 در 27 پست
    تعیین سطح نشده است

    استفاده از غلتک ماوس برای تغییر cobobox

    با سلام
    میشه اطلاعات داخل یه کمبوباکسو با چرخوندن غلتک ماوس تغییر داد؟
    یه کمبو باکس داریم که موارد اتخابی زیادی داره. جای اینکه اسکرول کمبوباکسو با کلیک ماوس جابجا کنیم بشه اونو با چرخوندن غلتک ماوس بالا یا پایین برد
    چنین کاری میشه انجام داد؟؟؟
    اخطار: این یک موضوع قدیمی است
    به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.
    پاسخ مورد نظر براي اين تاپيك ارسال شده است.
    اگر تنهاترين تنهايان شوم بازهم خدا هست،
    او جانشين تمام نداشته هاي من است...!

  2.  

  3. #2


    آخرین بازدید
    2022/06/26
    تاریخ عضویت
    January 2013
    محل سکونت
    شیراز
    نوشته ها
    1,199
    امتیاز
    3248
    سپاس
    1,570
    سپاس شده
    3,182 در 795 پست
    سطح اکسل
    84.00 %

    با درود
    خب امیدوارم با بیس اولیه اشنا داشته باشی- حال که بحث موس و اسکرول شد پس یه جا هم کمبو و هم لیس باکس و میگیم

    ابتدا یک ماژول ایجاد کنید و کد زیر رو درون اون کپی کنید
    کد:
    '''''' normal module code
    
    Option Explicit
    
    Private Type POINTAPI
            X As Long
            Y As Long
    End Type
    
    Private Type MOUSEHOOKSTRUCT
            pt As POINTAPI
            hwnd As Long
            wHitTestCode As Long
            dwExtraInfo As Long
    End Type
    
    Private Declare Function FindWindow Lib "user32" _
                                            Alias "FindWindowA" ( _
                                                            ByVal lpClassName As String, _
                                                            ByVal lpWindowName As String) As Long
    
    Private Declare Function GetWindowLong Lib "user32.dll" _
                                            Alias "GetWindowLongA" ( _
                                                            ByVal hwnd As Long, _
                                                            ByVal nIndex As Long) As Long
    
    Private Declare Function SetWindowsHookEx Lib "user32" _
                                            Alias "SetWindowsHookExA" ( _
                                                            ByVal idHook As Long, _
                                                            ByVal lpfn As Long, _
                                                            ByVal hmod As Long, _
                                                            ByVal dwThreadId As Long) As Long
    
    Private Declare Function CallNextHookEx Lib "user32" ( _
                                                            ByVal hHook As Long, _
                                                            ByVal nCode As Long, _
                                                            ByVal wParam As Long, _
                                                            lParam As Any) As Long
    
    Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
                                                            ByVal hHook As Long) As Long
    
    'Private Declare Function PostMessage Lib "user32.dll" _
    '                                         Alias "PostMessageA" ( _
    '                                                         ByVal hwnd As Long, _
    '                                                         ByVal wMsg As Long, _
    '                                                         ByVal wParam As Long, _
    '                                                         ByVal lParam As Long) As Long
    
    Private Declare Function WindowFromPoint Lib "user32" ( _
                                                            ByVal xPoint As Long, _
                                                            ByVal yPoint As Long) As Long
    
    Private Declare Function GetCursorPos Lib "user32.dll" ( _
                                                            ByRef lpPoint As POINTAPI) As Long
    
    Private Const WH_MOUSE_LL As Long = 14
    Private Const WM_MOUSEWHEEL As Long = &H20A
    Private Const HC_ACTION As Long = 0
    Private Const GWL_HINSTANCE As Long = (-6)
    
    'Private Const WM_KEYDOWN As Long = &H100
    'Private Const WM_KEYUP As Long = &H101
    'Private Const VK_UP As Long = &H26
    'Private Const VK_DOWN As Long = &H28
    'Private Const WM_LBUTTONDOWN As Long = &H201
    
    Private mLngMouseHook As Long
    Private mListBoxHwnd As Long
    Private mbHook As Boolean
    Private mCtl As MSForms.Control
    Dim n As Long
    
    Sub HookListBoxScroll(frm As Object, ctl As MSForms.Control)
    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Dim tPT As POINTAPI
         GetCursorPos tPT
         hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
         If Not frm.ActiveControl Is ctl Then
                 ctl.SetFocus
         End If
         If mListBoxHwnd <> hwndUnderCursor Then
                 UnhookListBoxScroll
                 Set mCtl = ctl
                 mListBoxHwnd = hwndUnderCursor
                 lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
                 ' PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
                 If Not mbHook Then
                         mLngMouseHook = SetWindowsHookEx( _
                                                         WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
                         mbHook = mLngMouseHook <> 0
                 End If
         End If
    End Sub
    
    Sub UnhookListBoxScroll()
         If mbHook Then
                    Set mCtl = Nothing
                 UnhookWindowsHookEx mLngMouseHook
                 mLngMouseHook = 0
                 mListBoxHwnd = 0
                 mbHook = False
            End If
    End Sub
    
    Private Function MouseProc( _
                 ByVal nCode As Long, ByVal wParam As Long, _
                 ByRef lParam As MOUSEHOOKSTRUCT) As Long
    Dim idx As Long
            On Error GoTo errH
         If (nCode = HC_ACTION) Then
                 If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then
                         If wParam = WM_MOUSEWHEEL Then
                                    MouseProc = True
    '                                If lParam.hwnd > 0 Then
    '                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
    '                                Else
    '                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
    '                                End If
    '                                PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                                    If lParam.hwnd > 0 Then idx = -1 Else idx = 1
                                 idx = idx + mCtl.ListIndex
                                 If idx >= 0 Then mCtl.ListIndex = idx
                                    Exit Function
                         End If
                 Else
                         UnhookListBoxScroll
                 End If
         End If
         MouseProc = CallNextHookEx( _
                                 mLngMouseHook, nCode, wParam, ByVal lParam)
         Exit Function
    errH:
         UnhookListBoxScroll
    End Function
    '''''''' end normal module code

    سپس یک یوزر فرم ایجاد کنید که حاوی یک کمبو باکس و یک لیست باکش باشه سپس کد زیر رو درون اون کپی کنید


    کد:
    Private Sub comboBox1_MouseMove( _
                            ByVal Button As Integer, ByVal Shift As Integer, _
                            ByVal X As Single, ByVal Y As Single)
                    HookListBoxScroll Me, Me.ComboBox1
    End Sub
    
    Private Sub ListBox1_MouseMove( _
                            ByVal Button As Integer, ByVal Shift As Integer, _
                            ByVal X As Single, ByVal Y As Single)
             HookListBoxScroll Me, Me.ListBox1
    End Sub
    Private Sub UserForm_Initialize()
    Dim i As Long
    Dim s As String
            s = "this is line "
            For i = 1 To 50
                            Me.ComboBox1.AddItem s & i
                            Me.ListBox1.AddItem s & i
                           
            Next
    End Sub
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
            UnhookListBoxScroll
    End Sub
    در این مثال به کمبو باکس و لیست باکس در لود شدن فرم مقدار داده شده - اگر شما خودتون محدوده میدین - قسمت initialize فرم نیاز نیست یا تغییرش بدین حال فرم رو ران کنید و تست کنید
    فايل هاي پيوست شده فايل هاي پيوست شده
    در پناه خداوندگار ایران زمین باشید و پیروز


  4. #3


    آخرین بازدید
    2020/11/02
    تاریخ عضویت
    October 2010
    محل سکونت
    قائمشهر
    نوشته ها
    114
    امتیاز
    54
    سپاس
    150
    سپاس شده
    53 در 27 پست
    تعیین سطح نشده است

    مثل هميشه عالي پاسخ دادين.ممنون
    اگر تنهاترين تنهايان شوم بازهم خدا هست،
    او جانشين تمام نداشته هاي من است...!

  5. سپاس ها (1)


  6. #4


    آخرین بازدید
    2022/05/13
    تاریخ عضویت
    January 2017
    نوشته ها
    244
    امتیاز
    29
    سپاس
    0
    سپاس شده
    19 در 15 پست
    تعیین سطح نشده است

    نقل قول نوشته اصلی توسط امين اسماعيلي نمایش پست ها
    با درود
    خب امیدوارم با بیس اولیه اشنا داشته باشی- حال که بحث موس و اسکرول شد پس یه جا هم کمبو و هم لیس باکس و میگیم

    ابتدا یک ماژول ایجاد کنید و کد زیر رو درون اون کپی کنید
    کد:
    '''''' normal module code
    
    Option Explicit
    
    Private Type POINTAPI
            X As Long
            Y As Long
    End Type
    
    Private Type MOUSEHOOKSTRUCT
            pt As POINTAPI
            hwnd As Long
            wHitTestCode As Long
            dwExtraInfo As Long
    End Type
    
    Private Declare Function FindWindow Lib "user32" _
                                            Alias "FindWindowA" ( _
                                                            ByVal lpClassName As String, _
                                                            ByVal lpWindowName As String) As Long
    
    Private Declare Function GetWindowLong Lib "user32.dll" _
                                            Alias "GetWindowLongA" ( _
                                                            ByVal hwnd As Long, _
                                                            ByVal nIndex As Long) As Long
    
    Private Declare Function SetWindowsHookEx Lib "user32" _
                                            Alias "SetWindowsHookExA" ( _
                                                            ByVal idHook As Long, _
                                                            ByVal lpfn As Long, _
                                                            ByVal hmod As Long, _
                                                            ByVal dwThreadId As Long) As Long
    
    Private Declare Function CallNextHookEx Lib "user32" ( _
                                                            ByVal hHook As Long, _
                                                            ByVal nCode As Long, _
                                                            ByVal wParam As Long, _
                                                            lParam As Any) As Long
    
    Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
                                                            ByVal hHook As Long) As Long
    
    'Private Declare Function PostMessage Lib "user32.dll" _
    '                                         Alias "PostMessageA" ( _
    '                                                         ByVal hwnd As Long, _
    '                                                         ByVal wMsg As Long, _
    '                                                         ByVal wParam As Long, _
    '                                                         ByVal lParam As Long) As Long
    
    Private Declare Function WindowFromPoint Lib "user32" ( _
                                                            ByVal xPoint As Long, _
                                                            ByVal yPoint As Long) As Long
    
    Private Declare Function GetCursorPos Lib "user32.dll" ( _
                                                            ByRef lpPoint As POINTAPI) As Long
    
    Private Const WH_MOUSE_LL As Long = 14
    Private Const WM_MOUSEWHEEL As Long = &H20A
    Private Const HC_ACTION As Long = 0
    Private Const GWL_HINSTANCE As Long = (-6)
    
    'Private Const WM_KEYDOWN As Long = &H100
    'Private Const WM_KEYUP As Long = &H101
    'Private Const VK_UP As Long = &H26
    'Private Const VK_DOWN As Long = &H28
    'Private Const WM_LBUTTONDOWN As Long = &H201
    
    Private mLngMouseHook As Long
    Private mListBoxHwnd As Long
    Private mbHook As Boolean
    Private mCtl As MSForms.Control
    Dim n As Long
    
    Sub HookListBoxScroll(frm As Object, ctl As MSForms.Control)
    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Dim tPT As POINTAPI
         GetCursorPos tPT
         hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
         If Not frm.ActiveControl Is ctl Then
                 ctl.SetFocus
         End If
         If mListBoxHwnd <> hwndUnderCursor Then
                 UnhookListBoxScroll
                 Set mCtl = ctl
                 mListBoxHwnd = hwndUnderCursor
                 lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
                 ' PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
                 If Not mbHook Then
                         mLngMouseHook = SetWindowsHookEx( _
                                                         WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
                         mbHook = mLngMouseHook <> 0
                 End If
         End If
    End Sub
    
    Sub UnhookListBoxScroll()
         If mbHook Then
                    Set mCtl = Nothing
                 UnhookWindowsHookEx mLngMouseHook
                 mLngMouseHook = 0
                 mListBoxHwnd = 0
                 mbHook = False
            End If
    End Sub
    
    Private Function MouseProc( _
                 ByVal nCode As Long, ByVal wParam As Long, _
                 ByRef lParam As MOUSEHOOKSTRUCT) As Long
    Dim idx As Long
            On Error GoTo errH
         If (nCode = HC_ACTION) Then
                 If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then
                         If wParam = WM_MOUSEWHEEL Then
                                    MouseProc = True
    '                                If lParam.hwnd > 0 Then
    '                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
    '                                Else
    '                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
    '                                End If
    '                                PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                                    If lParam.hwnd > 0 Then idx = -1 Else idx = 1
                                 idx = idx + mCtl.ListIndex
                                 If idx >= 0 Then mCtl.ListIndex = idx
                                    Exit Function
                         End If
                 Else
                         UnhookListBoxScroll
                 End If
         End If
         MouseProc = CallNextHookEx( _
                                 mLngMouseHook, nCode, wParam, ByVal lParam)
         Exit Function
    errH:
         UnhookListBoxScroll
    End Function
    '''''''' end normal module code

    سپس یک یوزر فرم ایجاد کنید که حاوی یک کمبو باکس و یک لیست باکش باشه سپس کد زیر رو درون اون کپی کنید


    کد:
    Private Sub comboBox1_MouseMove( _
                            ByVal Button As Integer, ByVal Shift As Integer, _
                            ByVal X As Single, ByVal Y As Single)
                    HookListBoxScroll Me, Me.ComboBox1
    End Sub
    
    Private Sub ListBox1_MouseMove( _
                            ByVal Button As Integer, ByVal Shift As Integer, _
                            ByVal X As Single, ByVal Y As Single)
             HookListBoxScroll Me, Me.ListBox1
    End Sub
    Private Sub UserForm_Initialize()
    Dim i As Long
    Dim s As String
            s = "this is line "
            For i = 1 To 50
                            Me.ComboBox1.AddItem s & i
                            Me.ListBox1.AddItem s & i
                           
            Next
    End Sub
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
            UnhookListBoxScroll
    End Sub
    در این مثال به کمبو باکس و لیست باکس در لود شدن فرم مقدار داده شده - اگر شما خودتون محدوده میدین - قسمت initialize فرم نیاز نیست یا تغییرش بدین حال فرم رو ران کنید و تست کنید

    سلام و عرض ادب
    می‌خواستم ببینم میشه این دستور رو در مورد تكس باكس هم انجام داد؟
    من امتحان كردم اینجوری روی تكس باكس جواب نمیده


اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

موضوعات مشابه

  1. تغییر رنگ لیبل در یوزرفرم با حرکت موس
    توسط علی فاطمی در انجمن فرم ها در ويژوال بيسيك - Forms in VBA
    پاسخ ها: 7
    آخرين نوشته: 2021/12/17, 20:27
  2. تغییرات باحرکت موس روی لیبل،تکست باکس یاغیره
    توسط حسینعلی در انجمن سوالات پیرامون ويژوال بيسيك - VBA Questions
    پاسخ ها: 2
    آخرين نوشته: 2014/07/20, 14:25
  3. مشکل : تغییر ناخواسته ابعاد کامنت
    توسط hs208 در انجمن سوالات اكسل - Excel Questions
    پاسخ ها: 7
    آخرين نوشته: 2014/05/03, 19:54
  4. تغییر رنگ با استفاده از شرط
    توسط masoud nouri در انجمن سوالات اكسل - Excel Questions
    پاسخ ها: 1
    آخرين نوشته: 2014/04/12, 02:55
  5. انتخاب اطلاعات لیست بدون استفاده از ماوس
    توسط nayyeri1982 در انجمن سوالات اكسل - Excel Questions
    پاسخ ها: 4
    آخرين نوشته: 2012/12/31, 13:30

بازدید کنندگان با جستجو های زیر این صفحه را پیدا کرده اند

انجمن اكسل ايران , اكسل , اكسس , سوال و جواب اكسل , سوال اكسس , انجمن اكسل ايران , توابع اكسل, آموزش اكسل, آموزش اكسس, VBA, ويژوال بيسيك

کلمات کلیدی این موضوع

علاقه مندی ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  
  • BB code ها فعال هستند
  • شکلک ها فعال هستند
  • کد [IMG] فعال است
  • کد [VIDEO] فعال است
  • کد HTML غیر فعال است
با ما در تماس باشيد