ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[Doğan038]

Merhabalar
Daha önce formda maouse tekerleği için kod aramıştım bu form sitesinde buldum aradığımı
işime yarayan kod aşağıda ki gibi


Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Public 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
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type

Public Const HC_ACTION = 0
Public Const WH_MOUSE_LL = 14
Public Const WM_MOUSEWHEEL = &H20A

Public hhkLowLevelMouse, lngInitialColor As Long
Public udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer
Public EvnIndex As Integer


Public Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
GetHookStruct = udtlParamStuct
End Function

Public Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
LowLevelMouseProc = True
With UserForm1.ComboBox1
If GetHookStruct(lParam).mouseData > 0 Then
.TopIndex = intTopIndex - 1
intTopIndex = .TopIndex
Else
.TopIndex = intTopIndex + 1
intTopIndex = .TopIndex
End If
End With

With UserForm1.ComboBox2
If GetHookStruct(lParam).mouseData > 0 Then
.TopIndex = EvnIndex - 1
EvnIndex = .TopIndex
Else
.TopIndex = EvnIndex + 1
EvnIndex = .TopIndex
End If
End With

End If
Exit Function
End If
LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function

Public Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub

Public Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
End Sub

yukarıdaki kod 32 bit de çok güzel çalşıyor
Fakat bu kod 64 bit de çalışmadı hata verdi.
hata mesajı şu şekilde

Compile error:

The code in this project must be updated for use on 64-bit
systems. Please review and update Declare statements and then
mark them with the PtrSafe attribute.

64 bit de çalışması için ne yapmamız lazım yardımcı olurmusunuz lütfen

SAYGILARIMLA

[halily]

64 bit için 2 sey yapmak gerekiyor
1. Kirmiziya donmus satirlarda sub yada functiondan önce ptrsafe kodunu eklemek ;
mesela Public Declare Function yaziyorsa
Public Declare PtrSafe Function yapmak
2. kısım daha zor Long turunde olan degerlerin türünü LongPtr yapmak. Ama hangileri longPtr olacak hangileri değişmeyecek o konuda bir bilgim yok, deneme yanılma yoluyla veri türü uyumsuzluğu olanlari tek tek denemeniz gerekebilir.

[Doğan038]

64 bit için 2 sey yapmak gerekiyor
1. Kirmiziya donmus satirlarda sub yada functiondan önce ptrsafe kodunu eklemek ;
mesela Public Declare Function yaziyorsa
Public Declare PtrSafe Function yapmak
2. kısım daha zor Long turunde olan degerlerin türünü LongPtr yapmak. Ama hangileri longPtr olacak hangileri değişmeyecek o konuda bir bilgim yok, deneme yanılma yoluyla veri türü uyumsuzluğu olanlari tek tek denemeniz gerekebilir.

Öcelikle çok teşekkür ederim cevabınız için

dediklerinizi yaptım kırmızılar normal oldu aşağı doğru inince yani tam bu sıra da hata verdi

Public Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub

public sub hook yazan yer sarı renkli oluyor
hata mesahı ise

type mismatch

[Doğan038]

64 bit için 2 sey yapmak gerekiyor
1. Kirmiziya donmus satirlarda sub yada functiondan önce ptrsafe kodunu eklemek ;
mesela Public Declare Function yaziyorsa
Public Declare PtrSafe Function yapmak
2. kısım daha zor Long turunde olan degerlerin türünü LongPtr yapmak. Ama hangileri longPtr olacak hangileri değişmeyecek o konuda bir bilgim yok, deneme yanılma yoluyla veri türü uyumsuzluğu olanlari tek tek denemeniz gerekebilir.

Öcelikle çok teşekkür ederim cevabınız için

dediklerinizi yaptım kırmızılar normal oldu aşağı doğru inince yani tam bu sıra da hata verdi

Public Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub

public sub hook yazan yer sarı renkli oluyor
hata mesahı ise

type mismatch

AdressOf LowLevelMouseProc bu kısımda seçili oluyor hata mesajı veriyor
type mismatch

tamama tıklayınca
public sub hook yazan yer de sarı renkli oluyor

[halily]

2. Maddede de belirttigim gibi hangi Long turu LongPtr olacak bilmiyorum. Hangi Long degerlerini LongPtr yaptiniz?

[Doğan038]

2. Maddede de belirttigim gibi hangi Long turu LongPtr olacak bilmiyorum. Hangi Long degerlerini LongPtr yaptiniz?

Long yazan ne varsa hepsini yaptım

yine olmadı

Sonra hepsini geri long yaptım yine olmadı

[halily]

sadece bazı Long değerleri LongPtr olacaktı kodları aşağıdaki gibi değiştirince Debugda hata vermedi ama gerçek anlamda çalışıyor mu bilmiyorum. bu kodları kullanma amacınız ne?
aşağıdaki değişiklikler dilerim işinize yarar

Kod: Tümünü seç

Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Public Declare PtrSafe Function GetForegroundWindow Lib "USER32" () As Long

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (ByVal Destination As LongPtr, _
    ByVal Source As LongPtr, _
    ByVal Length 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, lParam As Any) As LongPtr

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "USER32" (ByVal hhk As LongPtr) 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

Public Const HC_ACTION = 0
Public Const WH_MOUSE_LL = 14
Public Const WM_MOUSEWHEEL = &H20A

Public hhkLowLevelMouse, lngInitialColor As Long
Public udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer
Public EvnIndex As Integer


Public Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
GetHookStruct = udtlParamStuct
End Function

Public Function LowLevelMouseProc _
(ByVal ncode As Long, ByVal wParam As LongPtr, ByVal lParam As Long) As LongPtr
On Error Resume Next
If (ncode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
LowLevelMouseProc = True
With UserForm1.ComboBox1
If GetHookStruct(lParam).mousedata > 0 Then
.TopIndex = intTopIndex - 1
intTopIndex = .TopIndex
Else
.TopIndex = intTopIndex + 1
intTopIndex = .TopIndex
End If
End With

With UserForm1.ComboBox2
If GetHookStruct(lParam).mousedata > 0 Then
.TopIndex = EvnIndex - 1
EvnIndex = .TopIndex
Else
.TopIndex = EvnIndex + 1
EvnIndex = .TopIndex
End If
End With

End If
Exit Function
End If
LowLevelMouseProc = CallNextHookEx(0, ncode, wParam, ByVal lParam)
End Function

Public Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub

Public Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
End Sub

[Doğan038]

sadece bazı Long değerleri LongPtr olacaktı kodları aşağıdaki gibi değiştirince Debugda hata vermedi ama gerçek anlamda çalışıyor mu bilmiyorum. bu kodları kullanma amacınız ne?
aşağıdaki değişiklikler dilerim işinize yarar

Kod: Tümünü seç

Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Public Declare PtrSafe Function GetForegroundWindow Lib "USER32" () As Long

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (ByVal Destination As LongPtr, _
    ByVal Source As LongPtr, _
    ByVal Length 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, lParam As Any) As LongPtr

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "USER32" (ByVal hhk As LongPtr) 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

Public Const HC_ACTION = 0
Public Const WH_MOUSE_LL = 14
Public Const WM_MOUSEWHEEL = &H20A

Public hhkLowLevelMouse, lngInitialColor As Long
Public udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer
Public EvnIndex As Integer


Public Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
GetHookStruct = udtlParamStuct
End Function

Public Function LowLevelMouseProc _
(ByVal ncode As Long, ByVal wParam As LongPtr, ByVal lParam As Long) As LongPtr
On Error Resume Next
If (ncode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
LowLevelMouseProc = True
With UserForm1.ComboBox1
If GetHookStruct(lParam).mousedata > 0 Then
.TopIndex = intTopIndex - 1
intTopIndex = .TopIndex
Else
.TopIndex = intTopIndex + 1
intTopIndex = .TopIndex
End If
End With

With UserForm1.ComboBox2
If GetHookStruct(lParam).mousedata > 0 Then
.TopIndex = EvnIndex - 1
EvnIndex = .TopIndex
Else
.TopIndex = EvnIndex + 1
EvnIndex = .TopIndex
End If
End With

End If
Exit Function
End If
LowLevelMouseProc = CallNextHookEx(0, ncode, wParam, ByVal lParam)
End Function

Public Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub

Public Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
End Sub

Öcelikle ilginiz için çok teşekkür ederim.
bu kodu combobox fare tekerleği için kullanıyordum lakin kullandığım sistem 32 bit idi fakat 64 bit olunca çalışmaz oldu hata verir oldu.
sizin gönderdiğiniz kodu komple kopyala yapıştır ile denedim fakat en alttakinin üzerinde ki public sub hook mouse yazan yer komple sarı uyarı ile hata verdi.

Galiba olmayacak sizede çok zahmet verdim yinede Allah razı olsun sizden yardımlarınız içinde çok teşekkür ederim.
olmayacak Galiba

[Doğan038]

Sorunu başka bir kod kullanarak çözdüm Halil bey ilgi ve alakanızdan dolayı sizlere çok ama çok teşekkür ederim.

[halily]

Çözümü bizimle de paylaşabilirseniz sevinirim çünkü ben de bu sorunla bogusmustum bir ara.

[Doğan038]

Çözümü bizimle de paylaşabilirseniz sevinirim çünkü ben de bu sorunla bogusmustum bir ara.

Tabiki Hem 64 bitte hemde 32 bitte çalışan kodu ekliyorum.

modül kısmına yazılacak

Kod: Tümünü seç

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
    Private Declare PtrSafe Function FindWindow Lib "user32" _
                                            Alias "FindWindowA" ( _
                                                            ByVal lpClassName As String, _
                                                            ByVal lpWindowName As String) As LongPtr ' not sure if this should be LongPtr
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
                                            Alias "GetWindowLongPtrA" ( _
                                                            ByVal hWnd As LongPtr, _
                                                            ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                                            Alias "GetWindowLongA" ( _
                                                            ByVal hWnd As LongPtr, _
                                                            ByVal nIndex As Long) As LongPtr
    #End If
    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, _
                                                           lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                            ByVal hHook As LongPtr) As LongPtr ' MAYBE Long
    'Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
    '                                         Alias "PostMessageA" ( _
    '                                                         ByVal hwnd As LongPtr, _
    '                                                         ByVal wMsg As Long, _
    '                                                         ByVal wParam As LongPtr, _
    '                                                         ByVal lParam As LongPtr) As LongPtr   ' MAYBE Long
    #If Win64 Then
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                            ByVal Point As LongLong) As LongPtr    '
    #Else
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                            ByVal xPoint As Long, _
                                                            ByVal yPoint As Long) As LongPtr    '
    #End If
    Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                                            ByRef lpPoint As POINTAPI) As LongPtr   'MAYBE Long
#Else
    Private Declare Function FindWindow Lib "user32" _
                                            Alias "FindWindowA" ( _
                                                            ByVal lpClassName As String, _
                                                            ByVal lpWindowName As String) As Long
    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 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 Declare Function GetCursorPos Lib "user32.dll" ( _
                                                            ByRef lpPoint As POINTAPI) As Long
#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)
'Private Const WM_KEYDOWN As Long = &H100
'Private Const WM_KEYUP As Long = &H101
'Private Const VK_UP As Long = &H26
'Private Const VK_DOWN As Long = &H28
'Private Const WM_LBUTTONDOWN As Long = &H201
Dim n As Long
Private mCtl As Object
Private mbHook As Boolean

'******************************************
'******************************************
Const scrollOnly As Boolean = True ' set to False to actually move selection when scrolling mouse wheel
'******************************************
'******************************************

#If VBA7 Then
    Private mLngMouseHook As LongPtr
    Private mListBoxHwnd As LongPtr
#Else
    Private mLngMouseHook As Long
    Private mListBoxHwnd As Long
#End If
     
Sub HookListBoxScroll(frm As Object, ctl As Object)
' big thanks to Peter Thornton (https://social.msdn.microsoft.com/Forums/en-US/9255d7d6-0266-45aa-9589-7533bd82d591/need-help-with-macro-to-make-an-userform-able-to-scroll-with-a-mouse?forum=isvvba)
' as well as user 'Fhorst' for 64 bit conversion help.
' option for scrolling
    Dim tPT As POINTAPI
    #If VBA7 Then
        Dim lngAppInst As LongPtr
        Dim hwndUnderCursor As LongPtr
    #Else
        Dim lngAppInst As Long
        Dim hwndUnderCursor As Long
    #End If
    GetCursorPos tPT
    #If Win64 Then
        hwndUnderCursor = WindowFromPoint(tPT.XY)
    #Else
        hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
    #End If
    If TypeOf ctl Is UserForm Then
        If Not frm Is ctl Then
               ctl.SetFocus
        End If
    Else
        If Not frm.ActiveControl Is ctl Then
             ctl.SetFocus
        End If
    End If
    If mListBoxHwnd <> hwndUnderCursor Then
        UnhookListBoxScroll
        Set mCtl = ctl
        mListBoxHwnd = hwndUnderCursor
        #If Win64 Then
            lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
        #Else
            lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
        #End If
        ' PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx( _
                                            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
        End If
    End If
End Sub

Sub UnhookListBoxScroll()
    If mbHook Then
        Set mCtl = Nothing
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mListBoxHwnd = 0
        mbHook = False
    End If
End Sub
#If VBA7 Then
    Private Function MouseProc( _
                            ByVal nCode As Long, ByVal wParam As Long, _
                            ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
        Dim idx As Long
        On Error GoTo errH
        If (nCode = HC_ACTION) Then
            #If Win64 Then
                If WindowFromPoint(lParam.Pt.XY) = mListBoxHwnd Then
                    If wParam = WM_MOUSEWHEEL Then
                        MouseProc = True
'                        If lParam.hWnd > 0 Then
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                        Else
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                        End If
'                        postMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                        If TypeOf mCtl Is Frame Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        ElseIf TypeOf mCtl Is UserForm Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        Else
                            If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                            '*************** MAKE scrollOnly False IF YOU WANT TO CHANGE THE SELECTION RATHER THAN JUST SCROLL ******
                            If scrollOnly Then
                                idx = idx + mCtl.TopIndex
                                If idx >= 0 Then mCtl.TopIndex = idx
                            Else
                                idx = idx + mCtl.ListIndex
                                If idx >= 0 Then mCtl.ListIndex = idx
                            End If
                            '*********************************************************************************************************
                        End If
                    Exit Function
                    End If
                Else
                    UnhookListBoxScroll
                End If
            #Else
                If WindowFromPoint(lParam.Pt.X, lParam.Pt.Y) = mListBoxHwnd Then
                    If wParam = WM_MOUSEWHEEL Then
                        MouseProc = True
'                        If lParam.hWnd > 0 Then
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                        Else
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                        End If
'                        postMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                        If TypeOf mCtl Is Frame Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        ElseIf TypeOf mCtl Is UserForm Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        Else
                            If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                            '*************** MAKE scrollOnly False IF YOU WANT TO CHANGE THE SELECTION RATHER THAN JUST SCROLL ******
                            If scrollOnly Then
                                idx = idx + mCtl.TopIndex
                                If idx >= 0 Then mCtl.TopIndex = idx
                            Else
                                idx = idx + mCtl.ListIndex
                                If idx >= 0 Then mCtl.ListIndex = idx
                            End If
                            '*********************************************************************************************************
                        End If
                        Exit Function
                    End If
                Else
                    UnhookListBoxScroll
                End If
            #End If
        End If
        MouseProc = CallNextHookEx( _
                                mLngMouseHook, nCode, wParam, ByVal lParam)
        Exit Function
errH:
        UnhookListBoxScroll
    End Function
#Else
    Private Function MouseProc( _
                            ByVal nCode As Long, ByVal wParam As Long, _
                            ByRef lParam As MOUSEHOOKSTRUCT) As Long
        Dim idx As Long
        On Error GoTo errH
        If (nCode = HC_ACTION) Then
            If WindowFromPoint(lParam.Pt.X, lParam.Pt.Y) = mListBoxHwnd Then
                If wParam = WM_MOUSEWHEEL Then
                    MouseProc = True
'                    If lParam.hWnd > 0 Then
'                    postMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                    Else
'                    postMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                    End If
'                    postMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                   
                    If TypeOf mCtl Is Frame Then
                        If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                        idx = idx + mCtl.ScrollTop
                        If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                            mCtl.ScrollTop = idx
                        End If
                    ElseIf TypeOf mCtl Is UserForm Then
                        If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                        idx = idx + mCtl.ScrollTop
                        If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                            mCtl.ScrollTop = idx
                        End If
                    Else
                        If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                        '*************** MAKE scrollOnly False IF YOU WANT TO CHANGE THE SELECTION RATHER THAN JUST SCROLL ******
                        If scrollOnly Then
                            idx = idx + mCtl.TopIndex
                            If idx >= 0 Then mCtl.TopIndex = idx
                        Else
                            idx = idx + mCtl.ListIndex
                            If idx >= 0 Then mCtl.ListIndex = idx
                        End If
                        '*********************************************************************************************************
                    End If
                    Exit Function
                End If
            Else
                UnhookListBoxScroll
            End If
        End If
        MouseProc = CallNextHookEx( _
        mLngMouseHook, nCode, wParam, ByVal lParam)
        Exit Function
errH:
        UnhookListBoxScroll
    End Function
#End If





userform kodları da bu şekilde

Kod: Tümünü seç

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
HookListBoxScroll Me, Me.ComboBox1
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
UnhookListBoxScroll
End Sub

Combobox yada listboxda sorunsuz bir şekilde çalışmaktadır.

Sistem hem 32 bit hemde 64 bitte sorunsuz bir şekilde çalışıyor.
Saygılarımla

[halily]

Teşekkürler sayın Doğan