Cursos, tutoriais e planilhas prontas

Caixa de listagem em Userform com rolagem de mouse

Share on facebook
Share on twitter
Share on linkedin
Share on whatsapp
Share on telegram

Leia também...

Caixa de listagem em Userform com rolagem de mouse

Nome de título complicado?! Se você não está habituado a usar macros, mais especificamente formulários (Userform), certamente é um nome bem complicado. Mas se este não é o seu caso, então você certamente sabe do que estou falando e de como é chato não poder usar a rodinha do mouse, o scroll, ou qualquer outro nome que isso possa ter, para poder descer e subir nas listas criadas dentro de um Userform. Sendo obrigado a descer e subir utilizando o mouse nas barras de rolagem ou ainda as setas direcionais do teclado.

A imagem abaixo mostra um Userform com uma caixa de listagem, ou Listbox. E como podemos ver a lista toda não cabe na tela, então existe a barra de rolagem, mas o rodinha do mouse que é bom, não funciona aqui.

Caixa de listagem em Userform com rolagem de mouse (1)

Este foi um problema que me incomodou durante um bom tempo, eu disse FOI, por que finalmente encontrei a solução e você que sofre com essa chatice vai poder se beneficiar.

Para resolver o problema devemos criar algumas macros que irão interpretar o girar da rodinha do mouse como se fosse o pressionar das setas direcionais do teclado. Se quiser você pode assistir o vídeo abaixo onde explico todo o passo-a-passo, ou continue lendo.


Vídeo explicativo

Coloque o vídeo em tela cheia para assistir normalmente


A Macro que permite a rolagem do mouse

Então considerando que você já tenha seu Userform com ListBox criado (veja o vídeo para saber como fazer) o próximo passo é criar um módulo com a macro que irá simular o movimento da rodinha do mouse. Assim, crie um novo módulo e insira o seguinte código (sim é grandinho).

Option Explicit

Private Type POINTAPI
 x As Long
 y As Long
End Type

Private Type MOUSEHOOKSTRUCT
pt As POINTAPI
#If VBA7 Then
 hwnd As LongPtr
 wHitTestCode As LongPtr
 dwExtraInfo As LongPtr
#Else
 hwnd As Long
 wHitTestCode As Long
 dwExtraInfo As Long
#End If
End Type

#If VBA7 Then
 Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
 Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
 Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr
 Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
 Private Declare PtrSafe Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
 Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As LongPtr, ByVal yPoint As LongPtr) As LongPtr
 Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As LongPtr
#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

#If VBA7 Then
 Private mLngMouseHook As LongPtr
 Private mListBoxHwnd As LongPtr
#Else
 Private mLngMouseHook As Long
 Private mListBoxHwnd As Long
#End If
Private mbHook As Boolean

Sub HookListBoxScroll()
 #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
 hwndUnderCursor = WindowFromPoint(tPt.x, tPt.y)
 If mListBoxHwnd <> hwndUnderCursor Then
 UnhookListBoxScroll
 mListBoxHwnd = hwndUnderCursor
 lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
 PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
 
 If Not mbHook Then
 #If VBA7 Then
 mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc64, lngAppInst, 0)
 #Else
 mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc32, lngAppInst, 0)
 #End If
 mbHook = mLngMouseHook <> 0
 End If
 End If
End Sub

Sub UnhookListBoxScroll()
 If mbHook Then
 UnhookWindowsHookEx mLngMouseHook
 mLngMouseHook = 0
 mListBoxHwnd = 0
 mbHook = False
 End If
End Sub

Private Function MouseProc64(ByVal nCode As LongPtr, ByVal wParam As LongPtr, ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
 On Error GoTo Erro64
 If (nCode = HC_ACTION) Then
 If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then
 If wParam = WM_MOUSEWHEEL Then
 MouseProc64 = True
 
 If lParam.hwnd = 4287102976# Or lParam.hwnd < 0 Then
 PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
 Else
 PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
 End If
 
 PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
 Exit Function
 End If
 Else
 UnhookListBoxScroll
 End If
 End If
 
 MouseProc64 = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
 Exit Function
Erro64:
 UnhookListBoxScroll
End Function

Private Function MouseProc32(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long
 On Error GoTo Erro32
 If (nCode = HC_ACTION) Then
 If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then
 If wParam = WM_MOUSEWHEEL Then
 MouseProc32 = 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
 Exit Function
 End If
 Else
 UnhookListBoxScroll
 End If
 End If
 
 MouseProc32 = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
 Exit Function
Erro32:
 UnhookListBoxScroll
End Function

Identificando a rolagem do mouse

Em seguida temos que criar uma macro dentro do Userform que contém a caixa de listagem para identificar o movimento da rodinha do mouse.

Então clique com o botão direito do mouse sobre o Userform que contém a lista e selecione Exibir código.

Caixa de listagem em Userform com rolagem de mouse (2)

E então, insira o seguinte código:

Private Sub Lista_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 If Not Me.ActiveControl Is Me.Lista Then
 Me.Lista.SetFocus
 End If
 HookListBoxScroll
End Sub

Sendo que, onde aparecer a palavra Lista altere com o nome da sua lista criada, para saber qual o nome da sua caixa de listagem ou para alterá-lo, selecione a lista e altere a informação conforme aparece na imagem seguinte.

Caixa de listagem em Userform com rolagem de mouse (3)

E está pronto, nada mais é necessário, da próxima vez que você abrir seu Userform a rodinha do mouse já vai funcionar na sua caixa de listagem 🙂


Acompanhe o Função Excel
facebook-logo youtube-logo googleplus-logo twitter-logo

Leia também...

Gráfico de pirâmide

Gráfico de pirâmide O gráfico de pirâmides é bastante utilizado para visualizar faixas etárias de alguma região geográfica, mas outras aplicações também podem ser beneficiadas

Ler »

PROCV com dados repetidos

PROCV com dados repetidos A função PROCV (clique aqui para conhecer mais) nos permite buscar um dado correspondente a outro de forma bastante rápida e

Ler »

One thought on “Caixa de listagem em Userform com rolagem de mouse

Deixe um comentário ou uma dúvida

Compartilhe

Share on facebook
Share on twitter
Share on linkedin
Share on whatsapp
Share on telegram

Planilhas prontas

Histórico de Cotações

Baixe cotações históricas de ações, índices, moedas, criptomoedas, commodities e fundos em mais de 50 bolsas de valores no mundo, direto no Excel. Selecione os parâmetros desejados e deixe o arquivo fazer o resto para você, de forma rápida, simples e organizada.

Saber mais »

Gerador de Catálogos 3.1

Com o Gerador de catálogos do Função Excel você poderá criar catálogos personalizados de maneira muito fácil e rápida.

Os catálogos são gerados em formato PDF de forma automática, basta setar as configurações desejada e o arquivo fará tudo por você.

O catálogo é completamente customizável, cores, textos, imagens, fontes, tamanho e posicionamentos.

Gere seus catálogos e alavanque suas vendas.

Saber mais »

Planilha de Controle Uber, Cabify & 99 Pop

Com a Planilha de Controle Uber, Cabify & 99 Pop você terá total controle de seus ganhos e gastos como motorista, sabendo de onde vem e para onde vai seu dinheiro.
Com esta planilha você terá em detalhes todo o fluxo de dinheiro que envolve seu trabalho como motorista, e poderá controlar melhor sua renda.

Saber mais »

Ajude o Função Excel a continuar te ajudando, faça um PIX!

Leia também...

Faça uma doação

Nos ajude a continuar te ajudando.
Faça uma doação!

Compartilhe com o mundo

Gostou do artigo?
Não seja egoista, compartilhe!

Share on facebook
Share on twitter
Share on linkedin
Share on whatsapp

fique SEMPRE ATUALIZADO!

Junte-se a lista de e-mails do Função Excel

Receba e-mails semanais e melhore constantemente suas habilidades com Excel

Inscreva-se