Tela de Login com Design Moderno em VBA

Tela de Login com Design Moderno em VBA

Nesse vídeo eu te mostro que o layout do Userform VBA não precisa ter a aparência dos anos 90.

É possível modernizar, deixá-lo mais dinâmico, agradável ao usuário e clean. Veja o vídeo onde explico passo a passo.

'FERNANDO NEPOMUCENO - ORGANIC SHEETS
'CHAMADAS DE APIS RESPONSÁVEIS POR MANIPULAR AS CARACTERISTICAS DO USERFORM
'PARA DEIXA-LO TRANSPARENTE E SEM BORDAS

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" _
        Alias "SetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" ( _
        ByVal hWnd As Long) As Long

Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal crKey As Long, _
        ByVal bAlpha As Byte, _
        ByVal dwFlags As Long) As Long

'Constants for title bar
Private Const GWL_STYLE As Long = (-16)        'The offset of a window's style
Private Const GWL_EXSTYLE As Long = (-20)        'The offset of a window's extended style
Private Const WS_CAPTION As Long = &HC00000        'Style to add a titlebar
Private Const WS_EX_DLGMODALFRAME As Long = &H1        'Controls if the window has an icon

'Constants for transparency
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1        'Chroma key for fading a certain color on your Form
Private Const LWA_ALPHA = &H2        'Only needed if you want to fade the entire userform
Private m_sngDownX  As Single
Private m_sngDownY  As Single


Private Sub lbl_dark_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'ESTA FUNÇÃO PERMITE QUE EU ARRASTE O USERFORM PELO LABEL QUE REPRESENTA MEU BACKGROUND - MODO DARK
    If Button = 1 Then
        m_sngDownX = X
        m_sngDownY = Y
    End If
End Sub

Private Sub lbl_dark_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'ESTA FUNÇÃO MAPEIA MINHA COORDENADAS PARA QUE EU ARRASTE O USERFORM PELO LABEL QUE REPRESENTA MEU BACKGROUND - MODO DARK
    If Button And 1 Then
        Me.Left = Me.Left + (X - m_sngDownX)
        Me.Top = Me.Top + (Y - m_sngDownY)
    End If
End Sub

Private Sub lbl_white_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'ESTA FUNÇÃO PERMITE QUE EU ARRASTE O USERFORM PELO LABEL QUE REPRESENTA MEU BACKGROUND
    If Button = 1 Then
        m_sngDownX = X
        m_sngDownY = Y
    End If
End Sub

Private Sub lbl_white_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'ESTA FUNÇÃO MAPEIA MINHA COORDENADAS PARA QUE EU ARRASTE O USERFORM PELO LABEL QUE REPRESENTA MEU BACKGROUND
    If Button And 1 Then
        Me.Left = Me.Left + (X - m_sngDownX)
        Me.Top = Me.Top + (Y - m_sngDownY)
    End If
End Sub

Private Sub UserForm_Activate()
'ESTÁ FUNÇÃO APLICA AS TRANSPARENCIAS E OCULTA AS BORDAS QUANDO O USERFORM ESTIVER ATIVO

    HideTitleBarAndBorder Me        'hide the titlebar and border
    MakeUserFormTransparent Me        'make certain color transparent
End Sub

Sub MakeUserFormTransparent(frm As Object, Optional Color As Variant)

'FUNÇÃO QUE DEFINE A TRANSPARENCIA DO USERFORM

    Dim formhandle  As Long
    Dim bytOpacity  As Byte
    
    formhandle = FindWindow(vbNullString, Me.Caption)
    If IsMissing(Color) Then Color = 1257038        'default to vbwhite
    bytOpacity = 100        ' variable keeping opacity setting
    
    SetWindowLong formhandle, GWL_EXSTYLE, GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
    'The following line makes only a certain color transparent so the
    ' background of the form and any object whose BackColor you've set to match
    ' vbColor (default vbWhite) will be transparent.
    Me.BackColor = Color
    SetLayeredWindowAttributes formhandle, Color, bytOpacity, LWA_COLORKEY
End Sub

Sub HideTitleBarAndBorder(frm As Object)

'FUNÇÃO QUE OCULTA AS BORDAS DO USERFORM

    'Hide title bar and border around userform
    Dim lngWindow   As Long
    Dim lFrmHdl     As Long
    lFrmHdl = FindWindow(vbNullString, frm.Caption)
    'Build window and set window until you remove the caption, title bar and frame around the window
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    SetWindowLong lFrmHdl, GWL_STYLE, lngWindow
    lngWindow = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
    lngWindow = lngWindow And Not WS_EX_DLGMODALFRAME
    SetWindowLong lFrmHdl, GWL_EXSTYLE, lngWindow
    DrawMenuBar lFrmHdl
End Sub

Private Sub bt_fechar_dark_Click()
'BOTÃO DE FECHAMENTO DA JANELA - MODO DARK
    Unload Me
    Application.Visible = True
End Sub

Private Sub bt_fechar_white_Click()
'BOTÃO DE FECHAMENTO DA JANELA
    Unload Me
    Application.Visible = True
    
End Sub

Private Sub bt_go_dark_Click()

'AQUI VOCÊ PODE FAZER A SUA VALIDAÇÃO DO LOGIN - MODO DARK

    If Me.txt_login = "admin" And Me.txt_senha = "admin" Then
        MsgBox "Login realizado com sucesso!", vbInformation, "Organic Sheets"
    Else
        MsgBox "Login NÃO realizado, verifique a senha!", vbCritical, "Organic Sheets"
    End If
    
End Sub

Private Sub bt_go_white_Click()

'AQUI VOCÊ PODE FAZER A SUA VALIDAÇÃO DO LOGIN

    If Me.txt_login = "admin" And Me.txt_senha = "admin" Then
        MsgBox "Login realizado com sucesso!", vbInformation, "Organic Sheets"
    Else
        MsgBox "Login NÃO realizado, verifique a senha!", vbCritical, "Organic Sheets"
    End If
    
End Sub

Private Sub bt_linkedin_Click()
'APROVEITA E ME SEGUE LÁ NO LINKEDIN - OBRIGADO
    ActiveWorkbook.FollowHyperlink Address:="https://www.linkedin.com/in/fernando-nepomuceno-6a740599"
End Sub

Private Sub bt_modo_dark_Click()
'MUDA PARA O MODO DARK E ARMAZENA A ESCOLHA DO USUÁRIO
    Call modo_dark
    plan_aux.Range("A2") = "s"
End Sub

Private Sub bt_modo_white_Click()
'MUDA PARA O MODO WHITE E ARMAZENA A ESCOLHA DO USUÁRIO
    Call modo_white
    plan_aux.Range("A2") = "n"
End Sub


Private Sub bt_ocultar_senha_Click()

'MUDA A PROPRIEDADE DO TEXTBOX DE SENHA, TORNANDO A SENHA VISÍVEL

    If Me.txt_senha.PasswordChar = "•" Then
        Me.txt_senha.PasswordChar = ""
    Else
        Me.txt_senha.PasswordChar = "•"
    End If
    
End Sub

Private Sub bt_youtube_Click()
'APROVEITA E SE INSCREVE LÁ NO CANAL DA ORGANICSHEETS - OBRIGADO
    ActiveWorkbook.FollowHyperlink Address:="https://www.youtube.com/channel/UCYvI3mWCvFqQXeFOJptIULw?sub_confirmation=1"
End Sub

Private Sub lbl_cadastro_Click()
'AQUI VOCÊ PODE ESCREVER A LÓGICA PARA ARMAZENAR NOVO USUÁRIO
    MsgBox "Cadastro realizado com sucesso!", vbInformation, "Organic Sheets"
End Sub

Private Sub UserForm_Initialize()
'NO MODO INITIALIZE O SISTEMA CONFERE QUAL A PREFERENCIA DO USUÁRIO E ABRE NO MODO ESCOLHIDO

    If plan_aux.Range("A2").Text = "s" Then
       Call modo_dark
    Else
       Call modo_white
    End If
    
    
    With Me.lbl_dark
        .Left = Me.lbl_white.Left
        .Top = Me.lbl_white.Top
    End With
    
    With Me.bt_go_dark
        .Left = Me.bt_go_white.Left
        .Top = Me.bt_go_white.Top
    End With

End Sub



Private Sub webb_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'APÓS A APLICAÇÃO DO MODO DARK O GIF FICA COM UMA BORDA BRANCA, ESSE MÉTODO SERVER PARA MUDAR A COR DESSA BORDA
    If Me.lbl_dark.Visible = True Then
        webb.Document.body.bgcolor = 1841452
    End If
    
End Sub


Sub modo_dark()
'SUB PARA ATIVAR O MODO DARK, OCULTA TODOS OS ELEMENTOS DO MODO WHITE E CARREGA O GIF DO MODO DARK

    Dim gif As String
    
    Me.lbl_dark.Visible = True
    Me.bt_modo_dark.Visible = False
    Me.lbl_white.Visible = False
    Me.bt_modo_white.Visible = True
    Me.bt_fechar_dark.Visible = True
    Me.bt_fechar_white.Visible = False
    Me.lbl_bem_vindo.ForeColor = RGB(254, 255, 255)
    Me.lbl_orienta.ForeColor = RGB(254, 255, 255)
    Me.lbl_cad.ForeColor = RGB(254, 255, 255)

    Me.bt_go_white.Visible = False
    Me.bt_go_dark.Visible = True
    
    gif = ThisWorkbook.Path & "\images\Security-dark.gif"
    webb.Navigate "about:<html><body scroll='no'><img src='" & gif & "'style='display: block;margin-left: 0px;  margin-right: 0px;;height: 100%;width: 100%;'></img></body></html>"
    


End Sub

Sub modo_white()
'SUB PARA ATIVAR O MODO WHITE, OCULTA TODOS OS ELEMENTOS DO MODO DARK E CARREGA O GIF DO MODO WHITE
    Dim gif As String
        
    Me.lbl_dark.Visible = False
    Me.bt_modo_dark.Visible = True
    Me.lbl_white.Visible = True
    Me.bt_modo_white.Visible = False
    Me.bt_fechar_dark.Visible = False
    Me.bt_fechar_white.Visible = True
    Me.lbl_bem_vindo.ForeColor = &H80000012
    Me.lbl_orienta.ForeColor = &H404040
    Me.lbl_cad.ForeColor = &H404040
    
    Me.bt_go_white.Visible = True
    Me.bt_go_dark.Visible = False

    
    gif = ThisWorkbook.Path & "\images\Security.gif"
    webb.Navigate "about:<html><body scroll='no'><img src='" & gif & "'style='display: block;margin-left: 0px;  margin-right: 0px;;height: 100%;width: 100%;'></img></body></html>"

End Sub

Faça o Download