Making the MouseWheel function in the VBA editor. No DLL or EXE needed - All done from within Excel !!

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,806
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I have long looked for code that makes the mousewheel scroll the VBE code panes but I could only find some external programmes or dlls written in C.

with a bit of trial and error and a couple of tricks, i have put together this code done purely with VBA as you can see which I hope will be stable enough and will work accross different excel,OS versions.

Proceedings :

Just add the 2 parts of the below code to a normal workbook and save it as an AddIn (.xla) and set its IsAddin Property to TRUE in the Property window.

Once the addin is installed, the MouseWheel should hopefully work inside the VBA editor.

Code :

1- Put this code in a Standard module :

Code:
Option Explicit
 
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
 
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount 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 Type POINTAPI
  X As Long
  Y As Long
End Type
 
Private Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
 
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_VSCROLL As Long = &H115
Private Const SB_LINEUP As Long = 0
Private Const SB_LINEDOWN As Long = 1
Private Const SB_ENDSCROLL As Long = 8
 
Private lMouseHook   As Long
Public oNewApp As Application
 
Sub SetMouseHook()
 
    If lMouseHook <> 1 Then
 
        lMouseHook = SetWindowsHookEx _
        (WH_MOUSE_LL, _
        AddressOf LowLevelMouseProc, GetAppInstance, 0)
 
    End If
 
End Sub
 
Sub UnHookMouse()
 
    UnhookWindowsHookEx lMouseHook
    lMouseHook = 0
 
End Sub
 
Private Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, _
ByRef lParam As MSLLHOOKSTRUCT) As Long
 
    Dim RetVal As Long, lpClassName As String
    Dim lTargetWndhwnd As Long, lVertSBhwnd As Long
 
    On Error Resume Next
 
    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            lTargetWndhwnd = WindowFromPoint(lParam.pt.X, lParam.pt.Y)
            lpClassName = Space(256)
            RetVal = GetClassName(lTargetWndhwnd, lpClassName, 256)
            If UCase(Left$(lpClassName, RetVal)) _
            = UCase("vbaWindow") Then
                LowLevelMouseProc = True
                lVertSBhwnd = FindWindowEx _
                (lTargetWndhwnd, 0, "ScrollBar", vbNullString)
                lVertSBhwnd = FindWindowEx _
                (lTargetWndhwnd, lVertSBhwnd, "ScrollBar", vbNullString)
                If lParam.mouseData > 0 Then 'mousewheel up.
                    PostMessage _
                    lTargetWndhwnd, WM_VSCROLL, 2, lVertSBhwnd
                Else
                    PostMessage _
                    lTargetWndhwnd, WM_VSCROLL, 3, lVertSBhwnd
                End If
                PostMessage _
                lTargetWndhwnd, WM_VSCROLL, SB_ENDSCROLL, lVertSBhwnd
            End If
        End If
    End If
    LowLevelMouseProc = _
    CallNextHookEx(lMouseHook, nCode, wParam, ByVal lParam)
 
End Function
 
Private Function GetAppInstance() As Long
 
    GetAppInstance = GetWindowLong _
    (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
 
End Function
 
Sub CreateServerApp()
 
    If Len(Dir("C:\Ghost.xls")) = 0 Then
        ThisWorkbook.SaveCopyAs "C:\Ghost.xls"
        Set oNewApp = New Application
        With oNewApp
            .IgnoreRemoteRequests = True
            .Workbooks.Open "C:\Ghost.xls"
            .EnableEvents = False
            .Visible = False
            .Run "Ghost.xls!SetMouseHook"
        End With
    End If
 
End Sub


2- And this code is to be placed in the Workbook module :

Code:
Option Explicit
 
Private Sub Workbook_AddinInstall()
 
    MsgBox "VBE MouseWheel installed", vbInformation
 
End Sub
 
Private Sub Workbook_AddinUninstall()
 
    MsgBox "VBE MouseWheel Uninstalled", vbInformation
 
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
    On Error Resume Next
    If ThisWorkbook.IsAddin Then
        With oNewApp
            .Run "Ghost.xls!UnHookMouse"
            .IgnoreRemoteRequests = False
            .Workbooks("Ghost.xls").Close False
            .Quit
        End With
        If Len(Dir("C:\Ghost.xls")) <> 0 Then
            Kill (("C:\Ghost.xls"))
        End If
    End If
 
End Sub
 
Private Sub Workbook_Open()
 
    If ThisWorkbook.IsAddin Then
 
        Call UnHookMouse
        Call CreateServerApp
 
    End If
 
End Sub

A word of caution. Although the code worked fine for me and seemed stable , it may not be the same for other systems so please save your work before testing it !

Any comments & suggestions most welcome.

Tested on excel2003 XP.

Regards.
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Bump.

Has anyone tested this ? I would like some feedback in order to know if it is stable enough or if it otherwise needs some improvement.

Regards.
 
Upvote 0
Jaafar

My mousewheel works in the VBE without any need for code/DLLs/exes/add-ins.:)

And I'm pretty sure I didn't need to change any settings/options/whatever.
 
Upvote 0
My mousewheel is broken but I'm looking forward to testing this when I get home tonight. I will post back some point over the weekend and let you know how it behaves. Will test on 2003 and 2007.

I've long wished that I could scroll the VBE code pane with the mousewheel.
 
Upvote 0
Jaafar

My mousewheel works in the VBE without any need for code/DLLs/exes/add-ins.:)

And I'm pretty sure I didn't need to change any settings/options/whatever.
Ditto for me.
 
Upvote 0
Strange. It definitely doesn't work for me. Not at work (although wheel is broken at the moment), nor at home. It's bugged me for ages!

I wonder why it works for some and not for others? :confused:
 
Upvote 0
With the exception of Norie all the rest of us are in the U.S., but I have no clue if that makes a difference or not??? Also I have VB 6.5, which I recall I know it was an issue in VB6 which may also be a reason?

On a side not, I once had where my scroll wheel broke and came to realize how much I actually value it. Sorry Jon.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,454
Messages
6,178,766
Members
452,875
Latest member
Disastrouscoder

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top