VBA: como programar o deslocamento de um UserForm sem barra de janela

Faça uma pergunta
Para este exemplo, precisaremos previamente de um Userform denominado UserForm1. Nele, um botão de comando: CommandButton1. Este UserForm será apresentado sem uma barra de janela (cf Sub Mask_Bar) que poderá ser movido manualmente, bastando para tanto, pressionar a tecla Shift + clique esquerdo do mouse simultaneamente (cf Sub DeplaceForm e UserForm_MouseDown evento):


Como construir o código

O código, para ser aplicado dentro do módulo do UserForm é:
Option Explicit
 
Private LeHwnD As Long
 
'=================== Evetos
Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Mascara_Barra Me.Caption
End Sub
 
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'permite o deslocamento do Userform pela combinação Shift + clique esquerdo
    If Button = 1 And Shift = 1 Then DeplaceForm
End Sub
 
'=================== Procedimentos
Public Sub Mascara_Barra(strCapt As String)
Dim style As Long, index As Long
 
    index = -16
    LeHwnD = FindWindo("ThunderDFrame", strCapt)
    style = GetWindoLong(LeHwnD, index) And Not &HC00000
    SetWindoLong LeHwnD, index, style
    DrawMenuB LeHwnD
End Sub
 
'=================== Utilizações das funções do aplicativo 
Public Sub DeslocamentoForm()
'ReleaseCapture & SendMessageA
'https://www.developpez.net/forums/d1517529/autres-langages/general-visual-basic-6-vbscript/vbscript/vos-contributions-vbscript/hta-deplacer-hta-n-barre-titre-bordures/
    ExecuteExcel4Macro "CALL(""user32"",""ReleaseCapture"",""JJ"")"
    ExecuteExcel4Macro "CALL(""user32"",""SendMessageA"",""JJJJJ"",""" & LeHwnD & """,""" & &HA1 & """,""" & &O2 & """,""0"")"
End Sub
 
Private Function FindWindo(ClassName As String, Caption As String) As Long
'FindWindowA
    FindWindo = ExecuteExcel4Macro("CALL(""user32"",""FindWindowA"",""JCC""," & """" & ClassName & """" & ", " & """" & Caption & """)")
End Function
 
Private Function GetWindoLong(ByVal hwnd As Long, ByVal nIndex As Long) As Long
'GetWindowLongA
    GetWindoLong = ExecuteExcel4Macro("CALL(""user32"",""GetWindowLongA"",""JCA""," & hwnd & ", " & nIndex & ")")
End Function
 
Private Sub SetWindoLong(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
'SetWindowLongA
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & nIndex & ", " & dwNewLong & ")")
End Sub
 
Private Sub DrawMenuB(H As Long)
'DrawMenuBar
    ExecuteExcel4Macro ("CALL(""user32"",""DrawMenuBar"",""JJ"", " & H & ")")
End Sub

Exemplo para o download: aplicado ao Excel

Veja esta contribuição como a apresentação de uma possibilidade oferecida pelo Método ExecuteExcel4Macro aqui. Para visiualizar, clique, no alto da planilha Habilitar edição e, depois, no botão Show.


Jean-François Pillou

Jean-François Pillou - Fundador do CCM
Mais conhecido como Jeff, Jean-François Pillou é o fundador do CommentCaMarche.net. Ele também é CEO do CCM Benchmark e diretor digital do Grupo Figaro.

Mais informações sobre a equipe do CCM