Olá amigos.
O artigo de hoje é em resposta ao leitor Alexandro. Eis sua pergunta:
Saudações, quando criei um formulário no Excel (usando VBA),
os usuários reclamaram bastante dele, pois não se tem os botões
maximizar, minimizar, não se pode usar o botão do meio do mouse (rolagem para cima e para baixo),
além de não podê-lo redimensioná-lo verticalmente, em diagonal ou horizontalmente, além
de num textbox ou combobox não se pode clicar com botão direito com uma opção para colar algo
da área de transferência (daí deve-se usar control + V).
Tem alguma propriedade de formulário que faz isso ?
Como estes detalhes podem ser feitos em um formulário do EXCEL VBA ?
Obrigado Obrigado Obrigado
São várias questões que foram levantadas pelo Alexandro. Vou respondê-las em dois artigos para facilitar o entendimento de todos, ok.
Começarei explicando os detalhes para conseguir incluir os botões de minimizar e maximizar o formulário.
Primeiramente, tenho que dizer que vamos precisar recorrer ao uso de API do Windows pois o userform não tem em sua lista de propriedades opções para estas funcionalidades.
Então, note que, se o usuário tem necessidade de minimizar o formulário, deve ser permitido a ele, acessar o restante do aplicativo, ou seja, as outras planilhas, outros arquivo do excel, enfim, o formulário NÃO poderá ser uma janela do tipo modal, portanto, lembre-se de definir propriedade ShowModal do userform para False.
Você vai precisar de um módulo global no seu projeto, para poder definir a chamada das funções API necessárias. Veja abaixo o código que deverá ser inserido no módulo.
Módulo1:
Option Explicit
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal Destination As Long, ByVal Source As Long, ByVal Length 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
Type POINTAPI
X As Long
Y As Long
End Type
Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Const HC_ACTION = 0
Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A
Dim hhkLowLevelMouse, lngInitialColor As Long
Dim udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
GetHookStruct = udtlParamStuct
End Function
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
'ATENÇÃO: Troque o nome do seu Userform
With UserForm1
'ROLAR PARA CIMA
If GetHookStruct(lParam).mouseData > 0 Then
.ScrollTop = intTopIndex - 10
intTopIndex = .ScrollTop
Else
'ROLAR PARA BAIXO
.ScrollTop = intTopIndex + 10
intTopIndex = .ScrollTop
End If
End With
End If
Exit Function
End If
UnhookWindowsHookEx hhkLowLevelMouse
LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
Sub Hook_Mouse()
If hhkLowLevelMouse <> 0 Then
UnhookWindowsHookEx hhkLowLevelMouse
End If
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub
Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
End Sub
Agora, o módulo do Userform1:
Option Explicit
Private Sub UserForm_Initialize()
Dim hWnd As Long
'Vai para o topo do formulário
ScrollTop = 0
'Define os botões minimizar e maximizar do form
hWnd = FindWindow(vbNullString, UserForm1.Caption)
SetWindowLong hWnd, -16, &H20000 Or &H10000 Or &H84C80080
End Sub
Private Sub UserForm_Scroll(ByVal ActionX As MSForms.fmScrollAction, ByVal ActionY As MSForms.fmScrollAction, ByVal RequestDx As Single, ByVal RequestDy As Single, ByVal ActualDx As MSForms.ReturnSingle, ByVal ActualDy As MSForms.ReturnSingle)
'Evento do trackball do mouse
intTopIndex = ScrollTop
Call Hook_Mouse
End Sub
Private Sub UserForm_Terminate()
Call UnHook_Mouse
End Sub
Private Sub UserForm_Deactivate()
Call UnHook_Mouse
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call UnHook_Mouse
End Sub
Com esses códigos inseridos no projeto já é possivel utilizar o botão de rolagem do mouse para percorrer todo o formulário e também é possível minimizar e maximizar a janela deste userform.
Eis a primeira parte da resposta. Na segunda parte será abordado como exibir um menu de contexto dentro de um controle textbox.
Até lá!
Reinaldo, quero primeiramente agradece-lo pelo artigo, e dizer que tive uma dificuldade com o funcionamento do código, a parte dos botões minimizar e maximizar funcionou perfeitamente , mas a parte do scrollbar não, mesmo habilitando a propriedade keepscrollbarsvisible do form como 3 e a propriedade scrollbars também, aparecem as barras vertical e horizontal porém desabilitadas. Desde já agradeço pela ajuda. Abç.
Resolvido!, valew!
Boa garoto!
Abração.