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

[Jaafar Tribak]

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 :

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 :

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.

 

[Jaafar Tribak]

Hi all and thanks for the followup.

I gather that the ability to scroll the VBE with the wheel relies on the Drivers of the mouse software. So depending on the mouse , you may or may not be able to scroll the VBE.

Indeed, there are free utilities out there that can be downloaded and fix the problem presumably written in a language other than VB. However, the point of this thread was to see IF and HOW this could be done with VBA from within Excel itself with no need for any external programs for the purpose of learning.

Regards.