TreeView (JKP) Mouse Scrolling - Make it work with this code

sijpie · Oct 21, 2015

Not a question, just some code to improve your project(s)

Jan-Karel Pieterse and Peter Thornton have some time ago developed a very nice alternative to the standard VBA TreeView, which overcomes all the issues with 32bit and 64 bit Windows and Office and looks nicer as well. And it is FREE.
An MSForms (all VBA) treeview

However the code as provided by Jan Karel and Peter does not cater for mouse scrolling; ie if your tree view extends outside the frame provided then scroll bars appear but you will need to click on the scroll bar to move the tree in the frame (The treeview is held in a Frame control).

Providing code to use the mouse scroll button means hooking into the mouse events using API codes. Peter Thornton provided a nice piece of code to scroll a combobox or listbox (http://social.msdn.microsoft.com/Fo...n-userform-listbox-in-excel-2010?forum=isvvba).
With the hard work done it was easier to adapt this to scrolling within a frame.

Note!!! Adding this code can affect the stability of your project, so test it in depth.

The code that intercepts the mouse events and tells the Frame what to do is as follows and should be stored in a standard code module.

Option Explicit ' >>>> This code to be in a Normal Code Module (for instance modMouseScroll) <<<< ' Based on code from Peter Thornton here: ' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba 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 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 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 Declare Function GetActiveWindow Lib "user32" () 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 cSCROLLCHANGE As Long = 20 Private mLngMouseHook As Long Private mFrameHwnd As Long Private mbHook As Boolean Private mCtl As MSForms.Control Dim n As Long Sub HookFrameScroll(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) '>> uncomment below if you want to give the treeview focus once the user scrolls it ' If Not frm.ActiveControl Is ctl Then ' ctl.SetFocus ' End If If mFrameHwnd <> hwndUnderCursor Then UnhookFrameScroll Set mCtl = ctl mFrameHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mFrameHwnd, GWL_HINSTANCE) If Not mbHook Then mLngMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf FrameMouseProc, lngAppInst, 0) mbHook = mLngMouseHook <> 0 End If End If End Sub Sub UnhookFrameScroll() If mbHook Then Set mCtl = Nothing UnhookWindowsHookEx mLngMouseHook mLngMouseHook = 0 mFrameHwnd = 0 mbHook = False End If End Sub Private Function FrameMouseProc( _ ByVal nCode As Long, ByVal wParam As Long, _ ByRef lParam As MOUSEHOOKSTRUCT) As Long On Error GoTo errH 'Resume Next If (nCode = HC_ACTION) Then If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mFrameHwnd Then If wParam = WM_MOUSEWHEEL Then FrameMouseProc = True If lParam.hwnd > 0 Then mCtl.ScrollTop = Application.Max(0, mCtl.ScrollTop - cSCROLLCHANGE) Else mCtl.ScrollTop = Application.Min(mCtl.ScrollHeight - mCtl.InsideHeight, mCtl.ScrollTop + cSCROLLCHANGE) End If Exit Function End If End If End If FrameMouseProc = CallNextHookEx( _ mLngMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookFrameScroll End Function 

Then we need to have the frame process the mouseover events. This can be done two ways
1. Add the code to the clsTreeView class
2. Add the code to the userform module

Don't do both!

1. Add the code to the clsTreeView class
Advantage: your treeviews in any form will have automatic scroll capability
Disadvantage: when updating the classmodules with a new version, you will need to remember to copy this code. so mark it.

Add the following code to the class module, I put it (about halfway) after the TreeControl_Click() sub

' This Sub needs to be added to the clsTreeView class module ' <<< Added for mouse scrolling >>> Private Sub TreeControl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' intercept the mouse move events and use it to scroll the treeview HookFrameScroll Me.TreeControl.Parent, TreeControl End Sub 

2. Add the code to the userform module
Advantage: no messing with the class module
Disadvantage: need to add it for every treeview used

Add the following code to the Userform module where the treeview is. I have kept the framename as used in the Treeview Demo.

Private Sub frTreeControl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' intercept the mouse move events and use it to scroll the treeview HookFrameScroll Me, frTreeControl End Sub 

That's it. It's wonderful to see it work.

sijpie · Nov 20, 2018

That is a pity.
I don't have Access, so I can't test it either. I would suggest to create a small form in an Excel workbook with a simple listbox filled with enough text so that it has a scrollbar. Then test the code to see if it works on the listbox. Next create the same code in a clean access file, and see if it works there or if it crashes.

filipejrc · Nov 21, 2018

Thank you very much.
That is really a pity, but i'll try what you i'll try what you suggest.

Best regards

TreeView (JKP) Mouse Scrolling - Make it work with this code

sijpie

Well-known Member

sijpie

Well-known Member

Excel Facts

filipejrc

New Member

Similar threads

Forum statistics

Share this page

TreeView (JKP) Mouse Scrolling - Make it work with this code

sijpie

Well-known Member

sijpie

Well-known Member

Excel Facts

filipejrc

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock