Userform de login que usuario este en una celda
Hola...
Estoy preparando un programa de producción y cree un login con un userform y puse ahí que me validara lo siguiente:
Private Sub Aceptar_Click()
If Usuario.Text = "Erick" And Password.Text = "prueba" Then
Unload Principal
Menu.Show
Else
If Usuario.Text = "Alex" And Password.Text = "prueba" Then
Unload Principal
Menu.Show
Else
MsgBox ("Usuario o Password Incorrecto .... Verifique")
Usuario.Text = ""
Password.Text = ""
Usuario.SetFocus
End If
End If
End Sub
Private Sub Cancelar_Click()
Cancelar.SetFocus
Unload Principal
End Sub
Y me funciona a la perfección pero como puedo hacer que cuando digite en el textbox(usuario) y el textbox(password) que lo lea de una celda y si es correcto me llame otro (formulario2) y que yo entro con el Usuario POR me permita usar todas las opciones del formulario2 y si es otro usuario que solo permita accesar algunas opciones, es como crear un administrador y usuarios terminales(por decirlo así).
Te agradecería mucho que me puedas ayudar.
Enrique
Estoy preparando un programa de producción y cree un login con un userform y puse ahí que me validara lo siguiente:
Private Sub Aceptar_Click()
If Usuario.Text = "Erick" And Password.Text = "prueba" Then
Unload Principal
Menu.Show
Else
If Usuario.Text = "Alex" And Password.Text = "prueba" Then
Unload Principal
Menu.Show
Else
MsgBox ("Usuario o Password Incorrecto .... Verifique")
Usuario.Text = ""
Password.Text = ""
Usuario.SetFocus
End If
End If
End Sub
Private Sub Cancelar_Click()
Cancelar.SetFocus
Unload Principal
End Sub
Y me funciona a la perfección pero como puedo hacer que cuando digite en el textbox(usuario) y el textbox(password) que lo lea de una celda y si es correcto me llame otro (formulario2) y que yo entro con el Usuario POR me permita usar todas las opciones del formulario2 y si es otro usuario que solo permita accesar algunas opciones, es como crear un administrador y usuarios terminales(por decirlo así).
Te agradecería mucho que me puedas ayudar.
Enrique
1 Respuesta
Respuesta de inforvago
1
Para lo primero te incluyo código para eso...
Private Sub Aceptar_Click()
Dim ValorBuscado, Cuadro
Dim Bandera As Boolean
Dim Registro, Variable, Activando, ArchivoCerrado
Dim lb As Workbook
Dim Aplicacion As FileSearch
Bandera = True
'el campo de usuario no debe estar vacio...
If Len(Trim(UsuarioD.Text)) <> 0 Then
' El mismo libro contiene una hoja con esos datos, y permanece oculta.
EsteLibro.Worksheets("acceso").Activate
Range("A1").Select
With Worksheets("acceso").Range("Y:Y")
'DEntro de la hoja se busca lo que tecleo el usuario.
Set Cuadro = .Find(Trim(UsuarioD.Text), LookIn:=xlValues, LookAt:=xlWhole)
' si fue localizado, verificamos la contraseña.
If Not Cuadro Is Nothing Then
Registro = Cuadro.Address
Rango = "$Z" + Mid(Registro, 3, Len(Registro) - 2)
Range(Rango).Select
Contraseña = ActiveCell.FormulaR1C1
Range("A1").Select
If ContraseñaD.Text = CStr(Contraseña) Then
' si la contraseña se abrio...
EsteLibro.Worksheets("acceso").Visible = xlSheetVisible
EsteLibro.Worksheets("acceso").Activate
EsteLibro.Worksheets("acceso").Range("X2").Select
ActiveCell.FormulaR1C1 = Trim(UsuarioD.Text)
'la hoja de datos propociona nombre de archivos para manipular.
EsteLibro.Worksheets("Datos").Visible = xlSheetVisible
EsteLibro.Worksheets("Datos").Activate
EsteLibro.Worksheets("Datos").Range("B2").Select
ArchivoNombre = ActiveCell.FormulaR1C1
EsteLibro.Worksheets("Datos").Range("B3").Select
ArchivoRuta = ActiveCell.FormulaR1C1
EsteLibro.Worksheets("Datos").Range("B3").Select
ArchivoRuta = ActiveCell.FormulaR1C1
' Cuando obtiene lo necesario... Oculta la hoja de datos.
EsteLibro.Worksheets("Datos").Visible = xlSheetHidden
Set cmdbar = CommandBars.Item(1)
' la siguiente parte lista los archivos posibles para abrir...
Set Aplicacion = Application.FileSearch
With Aplicacion
.NewSearch
.LookIn = ArchivoRuta ' donde va a buscar
.SearchSubFolders = True 'Buscar en los subfolders
.Filename = ArchivoNombre ' que va a buscar
.FileType = msoFileTypeExcelWorkbooks ' Tipo de archivo a buscar
.MatchTextExactly = True ' Una busqueda m´pas exacta
' Execute realiza el ordenamiento, asedente o descendente, así como la actualización de la lista
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending, AlwaysAccurate:=False) > 0 Then
Accesos.Height = 220.5
Accesos.Width = 389.25
Aceptar.Enabled = False
'salir.Enabled = False
InstruccionE.Visible = True
For I = 1 To .FoundFiles.Count
BaseInf.AddItem (.FoundFiles(I))
For Each lb In Workbooks
If lb.Name <> ThisWorkbook.Name Then
lb.Close savechanges:=False
End If
Next lb
Next I
BaseInf.SetFocus
'Set BasedeDatos = Workbooks.Open(ArchivoRuta + ArchivoNombre)
Else
MsgBox "La Base de Datos no fue localizada en la Ubicación dada" + ArchivoRuta
Bandera = False
End If
End With
'si el usuario es Administrador... tiene la opción de no abrir como tal la base e ingresar a los programas.
'esto lo hace paracticamente en automatico access pero aqui se tiene q hacer manual.
If Bandera = True Then
If UCase(Trim(CStr(UsuarioD.Text))) <> "ADMINISTRADOR" Then
Pasa = True
Macro = True
EsteLibro.Worksheets("acceso").Visible = xlSheetHidden
UsuarioNumero = Trim(UsuarioD.Text)
Else
Pasa = True
Macro = False
EsteLibro.Worksheets("acceso").Visible = xlSheetHidden
End If
Else
Pasa = False
Unload Accesos
End If
Else
Titulo = "Mensaje"
Mensaje = "Contraseña Invalida"
Respuesta = MsgBox(Mensaje, vbOKOnly, Titulo)
ContraseñaD.SetFocus
End If 'verifica usuarios
Else
Titulo = "Mensaje"
Mensaje = "El Usuario No Esta Registrado"
Respuesta = MsgBox(Mensaje, vbOKOnly, Titulo)
End If
End With
End If
Beep
End Sub
'de la lista de archivos localizados... de elige el que se va a abrir, con un doble click..
' y abre las hojas para ser visualizadas.
Private Sub BaseInf_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If BaseInf.ListIndex <> -1 Then
If UCase(Trim(CStr(UsuarioD.Text))) <> "ADMINISTRADOR" Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
If HojadeCalculo.Visible = xlSheetHidden Then
HojadeCalculo.Visible = xlSheetVisible
End If
Next HojadeCalculo
Else
Titulo = "Mensaje"
Mensaje = "¿Desea abrir la base de datos?"
Respuesta = MsgBox(Mensaje, vbOKCancel, Titulo)
If Respuesta = vbOK Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
If HojadeCalculo.Visible = xlSheetHidden Then
HojadeCalculo.Visible = xlSheetVisible
End If
Next HojadeCalculo
End If
End If
'** Recupera el tamaño chico
'Accesos.Height = 108
'Accesos.Width = 219.75
Unload Accesos
End If
End Sub
'esta opicón es para el administrador...
Private Sub BaseInf_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If BaseInf.ListIndex <> -1 Then
If UCase(Trim(CStr(UsuarioD.Text))) <> "ADMINISTRADOR" Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
' For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
' If HojadeCalculo.Visible = xlSheetHidden Then
' HojadeCalculo.Visible = xlSheetVisible
' End If
' Next HojadeCalculo
Else
Titulo = "Mensaje"
Mensaje = "¿Desea abrir la base de datos?"
Respuesta = MsgBox(Mensaje, vbOKCancel, Titulo)
If Respuesta = vbOK Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
If HojadeCalculo.Visible = xlSheetHidden Then
HojadeCalculo.Visible = xlSheetVisible
End If
Next HojadeCalculo
End If
End If
Accesos.Height = 108
Accesos.Width = 219.75
Unload Accesos
End If
End If 'verifica si se preiono enter
End Sub
'para salir de todo...
Private Sub salir_Click()
Pasa = False
Unload Accesos
End Sub
'Al iniciar abre la hoja de accesos para poder consultarla...
Private Sub UserForm_Initialize()
InstruccionE.Visible = False
Accesos.Height = 108
Accesos.Width = 219.75
EsteLibro.Worksheets("acceso").Visible = xlSheetVisible
EsteLibro.Worksheets("acceso").Activate
EsteLibro.Worksheets("acceso").Range("X2").Select
UsuarioD.Text = Trim(ActiveCell.FormulaR1C1)
Range("A1").Select
End Sub
'Checala y dime si cres q t funcione o si quieres que ayuda apersonaliza más a tus necesidades...
'
Private Sub Aceptar_Click()
Dim ValorBuscado, Cuadro
Dim Bandera As Boolean
Dim Registro, Variable, Activando, ArchivoCerrado
Dim lb As Workbook
Dim Aplicacion As FileSearch
Bandera = True
'el campo de usuario no debe estar vacio...
If Len(Trim(UsuarioD.Text)) <> 0 Then
' El mismo libro contiene una hoja con esos datos, y permanece oculta.
EsteLibro.Worksheets("acceso").Activate
Range("A1").Select
With Worksheets("acceso").Range("Y:Y")
'DEntro de la hoja se busca lo que tecleo el usuario.
Set Cuadro = .Find(Trim(UsuarioD.Text), LookIn:=xlValues, LookAt:=xlWhole)
' si fue localizado, verificamos la contraseña.
If Not Cuadro Is Nothing Then
Registro = Cuadro.Address
Rango = "$Z" + Mid(Registro, 3, Len(Registro) - 2)
Range(Rango).Select
Contraseña = ActiveCell.FormulaR1C1
Range("A1").Select
If ContraseñaD.Text = CStr(Contraseña) Then
' si la contraseña se abrio...
EsteLibro.Worksheets("acceso").Visible = xlSheetVisible
EsteLibro.Worksheets("acceso").Activate
EsteLibro.Worksheets("acceso").Range("X2").Select
ActiveCell.FormulaR1C1 = Trim(UsuarioD.Text)
'la hoja de datos propociona nombre de archivos para manipular.
EsteLibro.Worksheets("Datos").Visible = xlSheetVisible
EsteLibro.Worksheets("Datos").Activate
EsteLibro.Worksheets("Datos").Range("B2").Select
ArchivoNombre = ActiveCell.FormulaR1C1
EsteLibro.Worksheets("Datos").Range("B3").Select
ArchivoRuta = ActiveCell.FormulaR1C1
EsteLibro.Worksheets("Datos").Range("B3").Select
ArchivoRuta = ActiveCell.FormulaR1C1
' Cuando obtiene lo necesario... Oculta la hoja de datos.
EsteLibro.Worksheets("Datos").Visible = xlSheetHidden
Set cmdbar = CommandBars.Item(1)
' la siguiente parte lista los archivos posibles para abrir...
Set Aplicacion = Application.FileSearch
With Aplicacion
.NewSearch
.LookIn = ArchivoRuta ' donde va a buscar
.SearchSubFolders = True 'Buscar en los subfolders
.Filename = ArchivoNombre ' que va a buscar
.FileType = msoFileTypeExcelWorkbooks ' Tipo de archivo a buscar
.MatchTextExactly = True ' Una busqueda m´pas exacta
' Execute realiza el ordenamiento, asedente o descendente, así como la actualización de la lista
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending, AlwaysAccurate:=False) > 0 Then
Accesos.Height = 220.5
Accesos.Width = 389.25
Aceptar.Enabled = False
'salir.Enabled = False
InstruccionE.Visible = True
For I = 1 To .FoundFiles.Count
BaseInf.AddItem (.FoundFiles(I))
For Each lb In Workbooks
If lb.Name <> ThisWorkbook.Name Then
lb.Close savechanges:=False
End If
Next lb
Next I
BaseInf.SetFocus
'Set BasedeDatos = Workbooks.Open(ArchivoRuta + ArchivoNombre)
Else
MsgBox "La Base de Datos no fue localizada en la Ubicación dada" + ArchivoRuta
Bandera = False
End If
End With
'si el usuario es Administrador... tiene la opción de no abrir como tal la base e ingresar a los programas.
'esto lo hace paracticamente en automatico access pero aqui se tiene q hacer manual.
If Bandera = True Then
If UCase(Trim(CStr(UsuarioD.Text))) <> "ADMINISTRADOR" Then
Pasa = True
Macro = True
EsteLibro.Worksheets("acceso").Visible = xlSheetHidden
UsuarioNumero = Trim(UsuarioD.Text)
Else
Pasa = True
Macro = False
EsteLibro.Worksheets("acceso").Visible = xlSheetHidden
End If
Else
Pasa = False
Unload Accesos
End If
Else
Titulo = "Mensaje"
Mensaje = "Contraseña Invalida"
Respuesta = MsgBox(Mensaje, vbOKOnly, Titulo)
ContraseñaD.SetFocus
End If 'verifica usuarios
Else
Titulo = "Mensaje"
Mensaje = "El Usuario No Esta Registrado"
Respuesta = MsgBox(Mensaje, vbOKOnly, Titulo)
End If
End With
End If
Beep
End Sub
'de la lista de archivos localizados... de elige el que se va a abrir, con un doble click..
' y abre las hojas para ser visualizadas.
Private Sub BaseInf_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If BaseInf.ListIndex <> -1 Then
If UCase(Trim(CStr(UsuarioD.Text))) <> "ADMINISTRADOR" Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
If HojadeCalculo.Visible = xlSheetHidden Then
HojadeCalculo.Visible = xlSheetVisible
End If
Next HojadeCalculo
Else
Titulo = "Mensaje"
Mensaje = "¿Desea abrir la base de datos?"
Respuesta = MsgBox(Mensaje, vbOKCancel, Titulo)
If Respuesta = vbOK Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
If HojadeCalculo.Visible = xlSheetHidden Then
HojadeCalculo.Visible = xlSheetVisible
End If
Next HojadeCalculo
End If
End If
'** Recupera el tamaño chico
'Accesos.Height = 108
'Accesos.Width = 219.75
Unload Accesos
End If
End Sub
'esta opicón es para el administrador...
Private Sub BaseInf_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If BaseInf.ListIndex <> -1 Then
If UCase(Trim(CStr(UsuarioD.Text))) <> "ADMINISTRADOR" Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
' For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
' If HojadeCalculo.Visible = xlSheetHidden Then
' HojadeCalculo.Visible = xlSheetVisible
' End If
' Next HojadeCalculo
Else
Titulo = "Mensaje"
Mensaje = "¿Desea abrir la base de datos?"
Respuesta = MsgBox(Mensaje, vbOKCancel, Titulo)
If Respuesta = vbOK Then
Set BasedeDatos = Workbooks.Open(BaseInf.List(BaseInf.ListIndex))
'Base de datos
For Each HojadeCalculo In Workbooks(BasedeDatos.Name).Worksheets
If HojadeCalculo.Visible = xlSheetHidden Then
HojadeCalculo.Visible = xlSheetVisible
End If
Next HojadeCalculo
End If
End If
Accesos.Height = 108
Accesos.Width = 219.75
Unload Accesos
End If
End If 'verifica si se preiono enter
End Sub
'para salir de todo...
Private Sub salir_Click()
Pasa = False
Unload Accesos
End Sub
'Al iniciar abre la hoja de accesos para poder consultarla...
Private Sub UserForm_Initialize()
InstruccionE.Visible = False
Accesos.Height = 108
Accesos.Width = 219.75
EsteLibro.Worksheets("acceso").Visible = xlSheetVisible
EsteLibro.Worksheets("acceso").Activate
EsteLibro.Worksheets("acceso").Range("X2").Select
UsuarioD.Text = Trim(ActiveCell.FormulaR1C1)
Range("A1").Select
End Sub
'Checala y dime si cres q t funcione o si quieres que ayuda apersonaliza más a tus necesidades...
'
