Acredito que quem clicou neste post veio faminto pra saber se eu trazia a solução para a "migração" do Cod de 32 para 64.
Pois é, não trago . Mas vim perguntar se alguém faz ideia se isso é possível.
Andei fazendo algumas buscas e vi que é quase impossível, isso por conta da Microsoft que fez mudanças na "biblioteca" do Office 64 bits retirando algumas coisas importantes que haviam no Office 32 bits. (Como podem ver, não entendo muito bem do assunto, mas resumi o que entendi)
Estou atrás disso só pra poder adaptar o código da planilha postada pelo grande Mauro Coutinho (viewtopic.php?f=17&t=674) aqui neste fórum. Ao rodar o arquivo no meu excel surgem logo os error e avisos quanto a diferença das versões.
Alguém se habilita a comentar?
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Scroll Mouse em List Box (64 bits)
-
- Colaborador
- Mensagens: 33
- Registrado em: Sex Abr 22, 2016 5:54 pm
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: Scroll Mouse em List Box (64 bits)
Pedro Jhonata, boa noite.
Bem, ainda não consegui resolver esse problema, mas consegui achar um tutorial, com download, que parece funcionar.
Esse modelo é bem diferente do modelo postado aqui no fórum. Veja se vai lhe atender.
Segue link: Excel VBA USERFORMS #21 Use the Mouse Scroll Wheel for Listbox! Example included
Espero que resolva seu problema.
Abraços e FELIZ NATAL, pra ti e toda sua família.
Bem, ainda não consegui resolver esse problema, mas consegui achar um tutorial, com download, que parece funcionar.
Esse modelo é bem diferente do modelo postado aqui no fórum. Veja se vai lhe atender.
Segue link: Excel VBA USERFORMS #21 Use the Mouse Scroll Wheel for Listbox! Example included
Espero que resolva seu problema.
Abraços e FELIZ NATAL, pra ti e toda sua família.
- Alex Abreu
- Colaborador
- Mensagens: 31
- Registrado em: Sáb Jun 30, 2018 4:40 pm
- Localização: Rio do Campo/SC
- Contato:
Re: Scroll Mouse em List Box (64 bits)
Buenas, depois de tanto caçar coisas aqui vou ter a chance de contribuir com algo pela primeira vez
Eu consegui resolver um problema na macro para Mouse Scroll x64 que ao usar ela numa Combobox/Listbox ela ficava selecionando os itens de dentro ao rodar o mouse scroll ao invés de mover a barra de rolagem destes objetos!
Segue a macro com a observação que eu fiz:
Eu consegui resolver um problema na macro para Mouse Scroll x64 que ao usar ela numa Combobox/Listbox ela ficava selecionando os itens de dentro ao rodar o mouse scroll ao invés de mover a barra de rolagem destes objetos!
Segue a macro com a observação que eu fiz:
Código: Selecionar todos
'Acrescentar essa info no form não esquecer de trocar o nome do combobox
'Private Sub combobox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'HookListBoxScroll Me, Me.combobox
'End Sub
'''''' normal module code
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
#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 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 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 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 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
#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)
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 LongPtr, ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
#Else
Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
#End If
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
'Isso faz o Mouse Scroll selecionar os itens de dentro da Listbox/Combobox
' idx = idx + mCtl.ListIndex
' If idx >= 0 Then mCtl.ListIndex = idx
End If
'Isso faz o Mouse Scroll mover a barra de rolagem da Listbox/Combobox
idx = idx + mCtl.TopIndex
If idx >= 0 Then mCtl.TopIndex = idx
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
'Isso faz o Mouse Scroll selecionar os itens de dentro da Listbox/Combobox
' idx = idx + mCtl.ListIndex
' If idx >= 0 Then mCtl.ListIndex = idx
End If
'Isso faz o Mouse Scroll mover a barra de rolagem da Listbox/Combobox
idx = idx + mCtl.TopIndex
If idx >= 0 Then mCtl.TopIndex = idx
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