SEGUEM ABAIXO OS CÓDIGOS DESTE VÍDEO: Private Sub UserForm_Activate() Dim Lin As Integer Dim LinBox As Integer Dim Adm As Worksheet ListaA.Clear Lin = 4 LinBox = 0 Set Adm = Sheets("Admin") Do Until Adm.Cells(Lin, 2).Value = "" With ListaA .AddItem .List(LinBox, 0) = Adm.Cells(Lin, 1) .List(LinBox, 1) = Adm.Cells(Lin, 2) .List(LinBox, 2) = Adm.Cells(Lin, 4) .List(LinBox, 3) = Adm.Cells(Lin, 5) .List(LinBox, 4) = Adm.Cells(Lin, 6) .List(LinBox, 5) = Adm.Cells(Lin, 7) .List(LinBox, 6) = Adm.Cells(Lin, 8) .List(LinBox, 7) = Adm.Cells(Lin, 9) End With Lin = Lin + 1 LinBox = LinBox + 1 Loop End Sub '---------------------------------------------------------------------- Private Sub Botao_Enviar_Click() Dim Lin As Integer Dim Adm As Worksheet Lin = 4 Set Adm = Worksheets("Admin") If Usuario = "" Or Senha = "" Then MsgBox "Usuário ou senha incorretos!" Unload FormLogin Exit Sub End If Do While Lin < 14 If (Adm.Cells(Lin, 2) = Usuario And Adm.Cells(Lin, 3) = Senha) Then Adm.Range("K2").Value = Usuario Worksheets("Aba 01").Visible = xlVeryHidden Worksheets("Aba 02").Visible = xlVeryHidden Worksheets("Aba 03").Visible = xlVeryHidden Worksheets("Aba 04").Visible = xlVeryHidden Worksheets("Aba 05").Visible = xlVeryHidden Worksheets("Aba 06").Visible = xlVeryHidden If Adm.Cells(Lin, 4) = "x" Then Sheets("Aba 01").Visible = True If Adm.Cells(Lin, 5) = "x" Then Sheets("Aba 02").Visible = True If Adm.Cells(Lin, 6) = "x" Then Sheets("Aba 03").Visible = True If Adm.Cells(Lin, 7) = "x" Then Sheets("Aba 04").Visible = True If Adm.Cells(Lin, 8) = "x" Then Sheets("Aba 05").Visible = True If Adm.Cells(Lin, 9) = "x" Then Sheets("Aba 06").Visible = True Unload FormLogin ActiveWorkbook.Save Exit Sub End If Lin = Lin + 1 Loop MsgBox "Usuário ou senha incorretos!" Unload FormLogin Exit Sub End Sub '---------------------------------------------------------------------- Private Sub Botao_Cancelar_Click() Unload FormLogin End Sub '---------------------------------------------------------------------- Private Sub Senha_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'Critica somente letras minúsculas If (KeyAscii > 47 And KeyAscii < 58) Then KeyAscii = 0 End If Senha.Text = LCase(Senha.Text) End Sub '---------------------------------------------------------------------- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True End Sub
Olá amigo! Conhece alguma forma de salvar o excel com a tela de login no Drive e baixar ele mantendo o macro? Quando eu baixo aqui ele anula o macro e a janela de acesso é ignorada.
Olá Professor! Criei os códigos mas quando tento clicar no botão "Login(usuários)" dá erro e também não estou conseguindo atribuir a macro a este botão. Consegue me ajudar? Um abraço.
SEGUEM ABAIXO OS CÓDIGOS DESTE VÍDEO:
Private Sub UserForm_Activate()
Dim Lin As Integer
Dim LinBox As Integer
Dim Adm As Worksheet
ListaA.Clear
Lin = 4
LinBox = 0
Set Adm = Sheets("Admin")
Do Until Adm.Cells(Lin, 2).Value = ""
With ListaA
.AddItem
.List(LinBox, 0) = Adm.Cells(Lin, 1)
.List(LinBox, 1) = Adm.Cells(Lin, 2)
.List(LinBox, 2) = Adm.Cells(Lin, 4)
.List(LinBox, 3) = Adm.Cells(Lin, 5)
.List(LinBox, 4) = Adm.Cells(Lin, 6)
.List(LinBox, 5) = Adm.Cells(Lin, 7)
.List(LinBox, 6) = Adm.Cells(Lin, 8)
.List(LinBox, 7) = Adm.Cells(Lin, 9)
End With
Lin = Lin + 1
LinBox = LinBox + 1
Loop
End Sub
'----------------------------------------------------------------------
Private Sub Botao_Enviar_Click()
Dim Lin As Integer
Dim Adm As Worksheet
Lin = 4
Set Adm = Worksheets("Admin")
If Usuario = "" Or Senha = "" Then
MsgBox "Usuário ou senha incorretos!"
Unload FormLogin
Exit Sub
End If
Do While Lin < 14
If (Adm.Cells(Lin, 2) = Usuario And Adm.Cells(Lin, 3) = Senha) Then
Adm.Range("K2").Value = Usuario
Worksheets("Aba 01").Visible = xlVeryHidden
Worksheets("Aba 02").Visible = xlVeryHidden
Worksheets("Aba 03").Visible = xlVeryHidden
Worksheets("Aba 04").Visible = xlVeryHidden
Worksheets("Aba 05").Visible = xlVeryHidden
Worksheets("Aba 06").Visible = xlVeryHidden
If Adm.Cells(Lin, 4) = "x" Then Sheets("Aba 01").Visible = True
If Adm.Cells(Lin, 5) = "x" Then Sheets("Aba 02").Visible = True
If Adm.Cells(Lin, 6) = "x" Then Sheets("Aba 03").Visible = True
If Adm.Cells(Lin, 7) = "x" Then Sheets("Aba 04").Visible = True
If Adm.Cells(Lin, 8) = "x" Then Sheets("Aba 05").Visible = True
If Adm.Cells(Lin, 9) = "x" Then Sheets("Aba 06").Visible = True
Unload FormLogin
ActiveWorkbook.Save
Exit Sub
End If
Lin = Lin + 1
Loop
MsgBox "Usuário ou senha incorretos!"
Unload FormLogin
Exit Sub
End Sub
'----------------------------------------------------------------------
Private Sub Botao_Cancelar_Click()
Unload FormLogin
End Sub
'----------------------------------------------------------------------
Private Sub Senha_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Critica somente letras minúsculas
If (KeyAscii > 47 And KeyAscii < 58) Then
KeyAscii = 0
End If
Senha.Text = LCase(Senha.Text)
End Sub
'----------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
Melhor vídeo!! Depois de fazer vários e vários logins, esse código rodou 100%! Obrigada Professor!
Obrigado você
Muito bom! Obrigado, Explorar Excel.
Prof. Joaquim, nós que agradecemos!
Muito gentil por compartilhar o codigo, gostei muito
!!
Disponha!
Excelente código e obrigado por partilhar
Albano, eu que agradeço.
Nilton Castro.
Olá amigo! Conhece alguma forma de salvar o excel com a tela de login no Drive e baixar ele mantendo o macro? Quando eu baixo aqui ele anula o macro e a janela de acesso é ignorada.
Tem como fazer um sistema de login onde os dados ficam na web ?
Top
Fayne, obrigado mais uma vez pelo elogio.
Nilton Castro.
Se possível poderia desenvolver esse sistema, mas com banco de dados em Access. 👍
Carlos, o problema é que eu não tenho tempo para estudar Access, eu não entendo nada sobre ele.
Nilton Castro.
@@explorarexcel Ok 👍 sucesso!
Olá Professor! Criei os códigos mas quando tento clicar no botão "Login(usuários)" dá erro e também não estou conseguindo atribuir a macro a este botão. Consegue me ajudar? Um abraço.