[엑셀 VBA] 콤보박스와 리스트박스에 마우스 췰 스크롤 기능 추가하기

작성자
dra****
작성일
2021-05-13 14:42
조회
175

개요:

엑셀의 폼 컨트롤 이벤트에는 마우스 휠 스크롤 기능이 없습니다. 그래서 콤보박스나 리스트 박스를 스크롤 할 때는 옆의 스크롤 바를 잡고 내려야 하는 불편함이 있습니다. 이런 기능이 있으면 훨씬 수월하지 않을까 하는 아쉬움에 고민하다 괜찮은 코드를 발견하여 분석하고 약간 입맛에 맞게 수정하였습니다.

사용법

  1. 해당 콘트를 MouseMove 이벤트에 다음의 코드 삽입해서 마우스 Hook을 걸어 줌
  2. 콤보박스 RowSource에 이미 들어갈 목록을 지정해 놓아야 합니다. 저는 1~20까지 숫자를 임의로 이미 넣어 놓았습니다.
  3. 사용자 정의폼 CloseQuery 이벤트에서 마우스 Hook 기능 해제
Option Explicit
 
'1. 해당 컨트롤에 마우스 훅을 걸어 줍니다.
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
 
'2. 폼 종료 걸었던 훅을 해제합니다.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   UnhookListBoxScroll
End Sub

3. 다음의 모듈을 임의의 이름으로 하나 만들어 줍니다.

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 PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe 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 PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare PtrSafe 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 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
 
       '새 Instance에 마우스 포인트가 있는 콘트롤의 번호를 할당한다
       lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
 
 
       If Not mbHook Then
             mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
 
'        *** AddressOf Operator (Visual Basic)
'            Creates a delegate instance that references the specific procedure.
'
'            Syntax   VB AddressOf procedurename
'            procedurename : Required. Specifies the procedure to be referenced by the newly created delegate.
 
'        *** MouseProc function      https://docs.microsoft.com/en-us/windows/win32/winmsg/mouseproc
'
'           Description
'           An application-defined or library-defined callback function used with the SetWindowsHookEx function. The system calls this function whenever an application calls the GetMessage or PeekMessage function and there is a mouse message to be processed.
'           The HOOKPROC type defines a pointer to this callback function. MouseProc is a placeholder for the application-defined or library-defined function name.
 
             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 errHandle
      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 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
 
errHandle:
     UnhookListBoxScroll
End Function

4. 확인

폼 실행해서 컴보박스 클릭하고 스크롤 하면 잘 작동합니다.

5. 첨부파일

아래 첨부 파일 올려 놓았습니다.

 

회원등급 : 열매2단계
포인트 : 1379 EP
전체 1

전체 404
번호 제목 작성자 작성일 추천 조회
360
New 엑셀의 끝은 과연 어디인가? (4)
꾸루꾸루 | 2021.06.17 | 추천 4 | 조회 35
꾸루꾸루 2021.06.17 4 35
359
[엑셀 VBA] Naming Convention - 변수나 개체 이름 붙이는 관행 (2)
dra**** | 2021.06.14 | 추천 1 | 조회 37
dra**** 2021.06.14 1 37
358
[엑셀 VBA] 자동화 - FORMS를 이용한 직원 근무시간과 급여 계산하기
dra**** | 2021.06.13 | 추천 1 | 조회 54
dra**** 2021.06.13 1 54
357
고맙습니다 (3)
가자 ! 하자!! 아자!!! | 2021.06.13 | 추천 1 | 조회 42
가자 ! 하자!! 아자!!! 2021.06.13 1 42
356
방가워요 (1)
dfgh**** | 2021.06.11 | 추천 1 | 조회 28
dfgh**** 2021.06.11 1 28
355
[엑셀 VBA] 자동화 - 데이터 관리의 기본과 고급필터의 유용성
dra**** | 2021.06.10 | 추천 3 | 조회 63
dra**** 2021.06.10 3 63
354
방문 상담 요청 방법?
dr**** | 2021.06.10 | 추천 0 | 조회 43
dr**** 2021.06.10 0 43
353
모두 오빠두엑셀 덕분입니다. (2)
DollShe365 | 2021.06.10 | 추천 5 | 조회 94
DollShe365 2021.06.10 5 94
352
[APP] 심플한 날짜 계산기 첨부파일 (3)
dra**** | 2021.06.09 | 추천 0 | 조회 58
dra**** 2021.06.09 0 58
351
빌게이츠가 한글을 사랑한다는 말이 사실일까? 엑셀에서 확인
dra**** | 2021.06.08 | 추천 0 | 조회 56
dra**** 2021.06.08 0 56
350
엑린이(?)입니다 (3)
투덜이스머프 | 2021.06.06 | 추천 4 | 조회 58
투덜이스머프 2021.06.06 4 58
349
[마소 FORMS] 무료로 마소 서버를 이용하여 필요한 정보 수집하기 - 매우 쉬움 (3)
dra**** | 2021.06.06 | 추천 0 | 조회 52
dra**** 2021.06.06 0 52
348
[액셀 VBA] 자동화 - 직책별로 뽑은 직원들을 폼에 연동하여 수정 조회 하기
dra**** | 2021.06.03 | 추천 1 | 조회 83
dra**** 2021.06.03 1 83
347
이제야 알게 되어 아쉽다. (6)
wshm**** | 2021.06.03 | 추천 8 | 조회 101
wshm**** 2021.06.03 8 101
346
Q&A 채택하고 싶은데 어떤식으로 채택해야 하나요? (4)
0328 | 2021.06.01 | 추천 0 | 조회 50
0328 2021.06.01 0 50
345
벽돌쌓기 첨부파일 (6)
눈사람 | 2021.06.01 | 추천 5 | 조회 80
눈사람 2021.06.01 5 80
344
[엑셀 VBA] 자동화 - ONEDRIVE를 서버로 활용하기 - 화상영어 회사 자동화 사례 (3)
dra**** | 2021.05.30 | 추천 2 | 조회 88
dra**** 2021.05.30 2 88
343
[엑셀 함수] WEEKNUM()으로 구한 몇 주차로 다시 날짜 구하기
dra**** | 2021.05.29 | 추천 0 | 조회 56
dra**** 2021.05.29 0 56
342
[엑셀 VBA] 자동화 - 1. 데이터 입력, 2. 양식에 자동으로 대입 3. 이메일 자동 발송 (2)
dra**** | 2021.05.28 | 추천 1 | 조회 95
dra**** 2021.05.28 1 95
341
VBA 이메일 자동발송 개별발송 질문드립니다 (4)
소람 | 2021.05.27 | 추천 1 | 조회 69
소람 2021.05.27 1 69
340
"최대 이익을 내는 판매가격의 예측" 강의 관련 문의입니다!!!! (1)
naver_5ef1913e089b5 | 2021.05.27 | 추천 0 | 조회 44
naver_5ef1913e089b5 2021.05.27 0 44
339
[엑셀 함수] 엑셀에 쓰이는 모든 함수들입니다. 첨부파일 (9)
dra**** | 2021.05.26 | 추천 21 | 조회 179
dra**** 2021.05.26 21 179
338
[엑셀 VBA] 자동화의 딜레마 (8)
dra**** | 2021.05.25 | 추천 6 | 조회 162
dra**** 2021.05.25 6 162
337
[엑셀 VBA] 데이터베이스 다루기 (3)
dra**** | 2021.05.24 | 추천 2 | 조회 128
dra**** 2021.05.24 2 128
336
[엑셀 VBA]-[팁] 콤보박스에 시트에 있는 값을 자동으로 집어 넣기 (1)
dra**** | 2021.05.22 | 추천 0 | 조회 78
dra**** 2021.05.22 0 78