Hola, fijate puede que te sirva para hacer un adding, hasta donde probe funciona en las dos ventana de codigo y el debug.
Option Explicit
'Autor: Leandro Ascierto
'Web: www.leandroacierto.com.ar
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function SystemParametersInfo Lib "user32.dll" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Integer, lParam As Any) 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Const SPI_GETWHEELSCROLLLINES As Long = 104
Private Const GW_CHILD As Long = 5
Private Const GW_HWNDNEXT As Long = 2
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WH_GETMESSAGE As Long = &H3
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
PT As POINTAPI
End Type
Private IMWHEEL_MSG As Long
Private hHook As Long
Private WheelScrollLines As Long
Public Function InstalIDEWheel() As Boolean
Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WheelScrollLines, 0)
hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf Hook_Proc, 0, App.ThreadID)
End Function
Public Function UnInstalIDEWheel()
UnhookWindowsHookEx hHook
End Function
Function Hook_Proc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSG) As Long
Dim hWin As Long
Dim hScroll As Long
Dim i As Long
If lParam.message = WM_MOUSEWHEEL Then
hWin = WindowFromPoint(lParam.PT.X, lParam.PT.Y)
If ClassNameOf(hWin) = "VbaWindow" Then
hScroll = FindScroll(hWin, lParam.PT.Y)
If hScroll Then
For i = 1 To WheelScrollLines
If lParam.wParam > 0 Then
Call SendMessageLong(hScroll, WM_KEYDOWN, 38, 0)
Call SendMessageLong(hScroll, WM_KEYUP, 38, 0)
Else
Call SendMessageLong(hScroll, WM_KEYDOWN, 40, 0)
Call SendMessageLong(hScroll, WM_KEYUP, 40, 0)
End If
Next
End If
End If
End If
Hook_Proc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
Private Function FindScroll(ByVal hParent As Long, MousePosY As Long) As Long
Dim hChild As Long
Dim hDirectUIHWND As Long
Dim Rec As RECT
hChild = GetWindow(hParent, GW_CHILD)
Do While hChild
If ClassNameOf(hChild) = "ScrollBar" Then
GetWindowRect hChild, Rec
If MousePosY > Rec.Top And MousePosY < Rec.Bottom Then
FindScroll = hChild
Exit Do
End If
End If
hChild = GetWindow(hChild, GW_HWNDNEXT)
Loop
End Function
Private Function ClassNameOf(ByVal hwnd As Long) As String
Dim sClassName As String, Ret As Long
sClassName = String(256, Chr$(0))
Ret = GetClassName(hwnd, sClassName, 256)
If Ret Then ClassNameOf = Left$(sClassName, Ret)
End Function
Saludos.
