ComboBox Scroll with MouseWheel 2

O

Ohad1997

New Member
Joined
Aug 13, 2017
Messages
21
this code is design to enable scrolling with the mouse wheel in excel comboboxes placed on a worksheet(not userforms)
written by: Jaafar Tribak

for some reason this code only works on some computers
the computers this code didnt work in are:
win 10 office 2016 64bit
win 7 office 2013 32bit
although it did work in a machine running
win 10 office 2010 64bit

i dont understand why, the code just fail to hook the mousewheel to the combobox
if someone can offer a fix i will much appreciate it



code in standard module:
code
Code: 
Option Explicit

Type POINTAPI
    x As Long
    y As Long
End Type

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

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

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
        Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As LongPtr
    Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    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
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Dim hwnd As LongPtr, lMouseHook As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetActiveWindow Lib "user32" () As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
    Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    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
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
    Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Dim hwnd As Long, lMouseHook As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A
Const HC_ACTION = 0
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const MK_LBUTTON = &H1
Const SM_CXVSCROLL = 2

Dim oComboBox As Object

Sub SetComboBoxHook(ByVal Control As Object)
    Dim tpt As POINTAPI
    Dim sBuffer As String
    Dim lRet As Long
    
    Set oComboBox = Control
    RemoveComboBoxHook
    GetCursorPos tpt
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
        Dim lPt As LongPtr
        CopyMemory lPt, tpt, LenB(tpt)
        hwnd = WindowFromPoint(lPt)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        hwnd = WindowFromPoint(tpt.x, tpt.y)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    sBuffer = Space(256)
    lRet = GetClassName(GetParent(hwnd), sBuffer, 256)
    If InStr(Left(sBuffer, lRet), "MdcPopup") Then
        SetFocus hwnd
        [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
            lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.HinstancePtr, 0)
        [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
            lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.Hinstance, 0)
        [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    End If
End Sub

Sub RemoveComboBoxHook()
    UnhookWindowsHookEx lMouseHook
End Sub

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, lParam As MSLLHOOKSTRUCT) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

    Dim sBuffer As String
    Dim lRet As Long
    Dim tRect As RECT
        
    sBuffer = Space(256)
    lRet = GetClassName(GetActiveWindow, sBuffer, 256)
    If Left(sBuffer, lRet) = "wndclass_desked_gsk" Then Call RemoveComboBoxHook
    If IsWindow(hwnd) = 0 Then Call RemoveComboBoxHook
    
    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
                Dim lPt As LongPtr
                Dim Low As Long, High As Long
                Dim lParm As LongPtr
                CopyMemory lPt, lParam.pt, LenB(lParam.pt)
                If WindowFromPoint(lPt) = hwnd Then
            [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
                Dim Low As Integer, High As Integer
                Dim lParm As Long
                If WindowFromPoint(lParam.pt.x, lParam.pt.y) = hwnd Then
            [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
                    GetClientRect hwnd, tRect
                    If lParam.mouseData > 0 Then
                        Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2)
                        High = tRect.Top + ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1)
                        lParm = MakeLong_32_64(Low, High)
                    Else
                        Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2)
                        High = tRect.Bottom - ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1)
                        lParm = MakeLong_32_64(Low, High)
                    End If
                    PostMessage hwnd, WM_LBUTTONDOWN, MK_LBUTTON, lParm
                    PostMessage hwnd, WM_LBUTTONUP, MK_LBUTTON, lParm
            End If
        End If
    End If
    
    MouseProc = CallNextHookEx(lMouseHook, nCode, wParam, ByVal lParam)
End Function

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
    Function MakeLong_32_64(ByVal wLow As Long, ByVal wHigh As Long) As LongPtr
    Dim retVal As LongPtr, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 4
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 4
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 8
    MakeLong_32_64 = retVal
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Function MakeLong_32_64(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
    Dim retVal As Long, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 2
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 2
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 4
    MakeLong_32_64 = retVal
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    End Function


Code in the module of the worksheet where the combobox is embeeded :
code:
Code: 
Option Explicit

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Call SetComboBoxHook(ComboBox1)
End Sub

Private Sub ComboBox1_LostFocus()
    Call RemoveComboBoxHook
End Sub

Private Sub ComboBox1_Change()
[B][COLOR=#008000]    'change event not affected by the hook.[/COLOR][/B]
End Sub
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Ohad1997 said:
this code is design to enable scrolling with the mouse wheel in excel comboboxes placed on a worksheet(not userforms)
written by: Jaafar Tribak

for some reason this code only works on some computers
the computers this code didnt work in are:
win 10 office 2016 64bit
win 7 office 2013 32bit
although it did work in a machine running
win 10 office 2010 64bit

i dont understand why, the code just fail to hook the mousewheel to the combobox
if someone can offer a fix i will much appreciate it
Click to expand...

Hi Ohad1997,

I 've just seen this post and made the following changes .. If you can confirm that the following update is working it will be great.

Workbook example

Code: 
Option Explicit

Type POINTAPI
    x As Long
    y As Long
End Type

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

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

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As LongPtr
    Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    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
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Dim hwnd As LongPtr, lMouseHook As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetActiveWindow Lib "user32" () As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
    Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    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
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
    Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Dim hwnd As Long, lMouseHook As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A
Const HC_ACTION = 0
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const MK_LBUTTON = &H1
Const SM_CXVSCROLL = 2

Dim oComboBox As Object

Sub SetComboBoxHook(ByVal Control As Object)
    Dim tpt As POINTAPI
    Dim sBuffer As String
    Dim lRet As Long
    
    Set oComboBox = Control
    RemoveComboBoxHook
    GetCursorPos tpt
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 And Win64 Then
        Dim lPt As LongPtr
        CopyMemory lPt, tpt, LenB(tpt)
        hwnd = WindowFromPoint(lPt)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        hwnd = WindowFromPoint(tpt.x, tpt.y)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    sBuffer = Space(256)
    lRet = GetClassName(GetParent(hwnd), sBuffer, 256)
    If InStr(Left(sBuffer, lRet), "MdcPopup") Then
        SetFocus hwnd
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
            lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.HinstancePtr, 0)
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
            lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.Hinstance, 0)
        [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    End If
End Sub

Sub RemoveComboBoxHook()
    UnhookWindowsHookEx lMouseHook
End Sub


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, lParam As MSLLHOOKSTRUCT) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim sBuffer As String
    Dim lRet As Long
    Dim tRect As RECT
        
    sBuffer = Space(256)
    lRet = GetClassName(GetActiveWindow, sBuffer, 256)
    If Left(sBuffer, lRet) = "wndclass_desked_gsk" Then Call RemoveComboBoxHook
    If IsWindow(hwnd) = 0 Then Call RemoveComboBoxHook
    
    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 And Win64 Then
                Dim lPt As LongPtr
                Dim Low As Long, High As Long
                Dim lParm As LongPtr
                CopyMemory lPt, lParam.pt, LenB(lPt)
                If WindowFromPoint(lPt) = hwnd Then
            [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
                Dim Low As Integer, High As Integer
                Dim lParm As Long
                If WindowFromPoint(lParam.pt.x, lParam.pt.y) = hwnd Then
            [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
                    GetClientRect hwnd, tRect
                    If lParam.mouseData > 0 Then
                        Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2)
                        High = tRect.Top + ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1)
                        lParm = MakeLong_32_64(Low, High)
                    Else
                        Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2)
                        High = tRect.Bottom - ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1)
                        lParm = MakeLong_32_64(Low, High)
                    End If
                    PostMessage hwnd, WM_LBUTTONDOWN, MK_LBUTTON, lParm
                    PostMessage hwnd, WM_LBUTTONUP, MK_LBUTTON, lParm
            End If
        End If
    End If
    
    MouseProc = CallNextHookEx(lMouseHook, nCode, wParam, ByVal lParam)
End Function

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 And Win64 Then
    Function MakeLong_32_64(ByVal wLow As Long, ByVal wHigh As Long) As LongPtr
    Dim retVal As LongPtr, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 4
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 4
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 8
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function MakeLong_32_64(ByVal wLow As Integer, ByVal wHigh As Integer) As Long
    Dim retVal As Long, b(3) As Byte
    
    MoveMemory ByVal VarPtr(b(0)), ByVal VarPtr(wLow), 2
    MoveMemory ByVal VarPtr(b(2)), ByVal VarPtr(wHigh), 2
    MoveMemory ByVal VarPtr(retVal), ByVal VarPtr(b(0)), 4
    MakeLong_32_64 = retVal
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
299
huiettcm
H
A
  • Question
What is wrong with this VBA code: userForm get hand ico for pointer on hover
2
Replies
15
Views
517
RoryA
RoryA
Jaafar Tribak
  • Question
Blurring images using Direct2D & Windows Imaging Component
Replies
3
Views
253
Dan_W
D
W
  • Question
minimize and Maximize
Replies
4
Views
669
NdNoviceHlp
NdNoviceHlp
B
  • Question
Autosize combobox object suddenly crashes Excel
Replies
6
Views
441
alexofrhodes
alexofrhodes

Forum statistics

Threads
1,214,861
Messages
6,121,971
Members
449,059
Latest member
oculus

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top