UserForm com botões minimizar e maximizar e scrollbar que funciona com trackball do mouse

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á!

4 comentários em “UserForm com botões minimizar e maximizar e scrollbar que funciona com trackball do mouse”

  1. 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ç.

    Responder

Deixe um comentário