Em gặp tình huống như này là lỗi gì vậy thầy nhỉ?
Hình như phần này bạn đang sử dụng ứng dụng lăn chuột thay đổi listbox đúng không?
Vâng anh, nhưng chạy được khoảng 10 giây thì hiện lên thông báo như vậy em cũng không biết lí do vì sao nữa, nhờ anh xem giúp em với.
em gửi file anh kiểm tra giúp em nhé
Bạn đẩy file lên giúp gitiho nhé.
anh kiểm tra lại giúp em nhé. file cảu em bị 2 lỗi như nàyhttps://drive.google.com/file/d/15GJlOeKhmimR6-Ijw7a7dqIG7p6Bf1AM/view?usp=share_link
Phần này bạn thay code như sau nhé
Option Explicit
'************************************************************************************
#If Win64 Then
Private Type POINTAPI
XY As LongLong
End Type
#Else
Private Type POINTAPI
X As Long
Y As Long
End Type
#End If
Private Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As Long
wHitTestCode As Long
dwExtraInfo As Long
End Type
'************************************************************************************
#If VBA7 Then 'Office 64-bit
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As LongPtr, _
ByVal hmod As LongPtr, _
ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
ByVal hHook As LongPtr, _
ByVal nCode As Long, _
ByVal wParam As LongPtr, _
ByRef lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long
#Else ' Office 32-bit
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, _
ByRef lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long
#End If
#If Win64 Then
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
ByVal Point As LongLong) As LongPtr
#Else
#If VBA7 Then
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long) As LongPtr
#Else
Private Declare Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
#End If
#End If
'************************************************************************************
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)
'************************************************************************************
#If VBA7 Then
Private mLngMouseHook As LongPtr
Private mControlHwnd As LongPtr
#Else
Private mLngMouseHook As Long
Private mControlHwnd As Long
#End If
Private mbHook As Boolean
Private mCtl As Object
'************************************************************************************
Sub HookControlScroll(ByVal ctl As Object)
#If VBA7 Then
Dim lngAppInst As LongPtr
Dim hwndUnderCursor As LongPtr
#Else
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
#End If
Dim tPT As POINTAPI
GetCursorPos tPT
#If Win64 Then
hwndUnderCursor = WindowFromPoint(tPT.XY)
#Else
hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
#End If
If mControlHwnd <> hwndUnderCursor Then
UnhookControlScroll
Set mCtl = ctl
mControlHwnd = hwndUnderCursor
lngAppInst = GetWindowLong(mControlHwnd, GWL_HINSTANCE)
If Not mbHook Then
mLngMouseHook = _
SetWindowsHookEx(WH_MOUSE_LL, _
AddressOf MouseProc, _
lngAppInst, 0)
mbHook = mLngMouseHook <> 0
End If
End If
End Sub
'************************************************************************************
Sub UnhookControlScroll()
If mbHook Then
Set mCtl = Nothing
UnhookWindowsHookEx mLngMouseHook
mLngMouseHook = 0
mControlHwnd = 0
mbHook = False
End If
End Sub
'************************************************************************************
#If VBA7 Then
Private Function MouseProc( _
ByVal nCode As Long, _
ByVal wParam As LongPtr, _
ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
#Else
Private Function MouseProc( _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByRef lParam As MOUSEHOOKSTRUCT) As Long
#End If
On Error GoTo ErrorHandler
Dim Index As Long
If (nCode = HC_ACTION) Then
#If Win64 Then
If WindowFromPoint(lParam.pt.XY) = mControlHwnd Then
#Else
If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mControlHwnd Then
#End If
If wParam = WM_MOUSEWHEEL Then
MouseProc = True
If lParam.hwnd > 0 Then
Index = -1
Else
Index = 1
End If
Index = Index + mCtl.TopIndex
If Index >= 0 Then
mCtl.TopIndex = Index
End If
Exit Function
End If
Else
UnhookControlScroll
End If
End If
MouseProc = CallNextHookEx( _
mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
ErrorHandler:
UnhookControlScroll
End Function