Ingreso mediante usuario y contraseña

No entiendo que es el Empty que pones para los textbox; puedes probar con
TextBox1.Text = "" 'o lo que quieras
TextBox2.Text = ""
TextBox1. SetFocus
Igualmente yo en tu caso me quedaría con el código que te pasé y (en todo caso) grabar en algún lado si el usuario está en la lista (de esta forma te olvidas de las password pues si el usuario de la red está en la lista ya está).
Saludos y comenta que le seguimos dando la vuelta
Gustavo

Esta bueno el script. Lo que quiero hacer es un formulario como el que decís vos, tipo user/password. Ando dando vueltas hace un tiempo. La idea es poder usar este ingreso para poder ingresar a otra planilla (o la misma)y cargar datos identificando al autor. Estoy probando con formularios, pero no la domino. Tenía dudas también sobre donde alojar la tabla con los datos de los users/pass. Si me podes ayudar te agradecería.
El mail es: [email protected]
Saludos
Juan

Lo que hice es crear un formulario de ingreso con user y pass donde estos datos están guardados en un archivo "claves.xls". De ahí los tomo y los guardo en una matriz, y comparo el textbox con el user y pass. Si no coinciden tengo la posibilidad de probar otras cuatro veces. El problema que tengo es que no puedo ingresar nuevamente un user y pass porque el loop no me deja, ¿qué tengo que hacer para que me deje entrar datos y continué? Lo marque con *** la zona donde creo que esta el problema.
Private Sub CommandButton1_Click()
Dim user(100) As String
Dim pass(100) As String
Application.ScreenUpdating = False
If Cells(1000, 50) > Time Then
no_permitido = MsgBox("Por seguridad por el momento no se le permite ingresar", vbCritical, "Seguridad") 'Agregar comprobar fecha
ActiveWorkbook.Close
Else
Cells(1000, 50) = Empty
End If
If TextBox1 = Empty Or TextBox2 = Empty Then
ing_datos = MsgBox("Ingrese los datos faltantes", vbCritical, "Faltan datos")
Unload UserForm1
Load UserForm1
UserForm1.Show
End If
Workbooks.Open Filename:="claves.xls", Password:="prueba"
claves = ActiveWorkbook.Name
For fila = 1 To 5
user(fila) = "fgabdfjasdhfjasndf"
pass(fila) = "fgabdfjasdhfjasndf"
Next
For fila = 1 To 5
If Cells(fila, 1) = Empty Then Exit For
user(fila) = Cells(fila, 1)
pass(fila) = Cells(fila, 2)
Next
Windows(claves).Close
For intento = 1 To 5
For fila = 1 To 5
If user(fila) = TextBox1 And pass(fila) = TextBox2 Then
Sheets("hoja2").Select
Range("a1").Value = "OK"
Unload UserForm1
Exit Sub
End If
Next
mal_ingreso = MsgBox("Usuario o contaseña incorrectos", vbCritical, "Error")
**********************************
TextBox1 = Empty 'COMO CARGO DE NUEVO DATOS EN EL TEXTBOX????
TextBox2 = Empty
TextBox1.SetFocus
***************************************
Next
max_intentos = MsgBox("Máximo número de intentos permitidos", vbCritical, "Error")
hora = Hour(Now())
Min = Minute(Now())
Seg = Second(Now()) + 30
hora_sig_int = TimeSerial(hora, Min, Seg)
Cells(1000, 50) = hora_sig_int
ActiveWorkbook.Close savechanges:=True
End If
End Sub

El empty es para vaciar el user y pass que tiene cargado el formulario que son incorrectos. Lo que tiene que hacer el usuario es ponerlos de nuevo y darle aceptar para chequear de nuevo el login. Este archivo esta en una PC publica, con un usuario común, el registro de datos está limitado a unas personas solamente, que tienen su propio user y pass (esto lo uso en otras macros para rellenar con datos automáticamente).
Lo que me falta en la macro es que una vez que comprobó que la contraseña o user están mal, me deje escribir en el textbox de nuevo para ingresar de nuevo los datos, eso es lo que no me sale. El loop de reintentos que tengo no me lo permite, quisiera que parara el loop, ingrese datos y siga cuando le de al botón de comando aceptar.
Saludos
Juan

Si quieres crear un formulario de ingreso (típico User/Password) pásame tu mail y veo de enviarte algo; en caso contrario te paso un pequeño código que "captura" el usuario de red que está conectado (y tal vez puedas operar algo contra esto):
'Muestra el nombre de la PC y de Usuario.
Sub usuarioRed()
Dim ObjetoRed As Object
Set ObjetoRed = CreateObject("WScript.Network")
MsgBox "Nombre del PC en Red : " & ObjetoRed.ComputerName & vbCrLf & _
"Usuario: " & ObjetoRed.UserName, vbInformation, "Aviso"
Set ObjetoRed = Nothing
End Sub

Ok; entendí lo que preguntabas cuando lo ejecuté. Yo lo que haría es tener la cantidad de intentos en una variable externa (ej/ en una hoja oculta del libro) y cuando inicias el formulario la pones en 1 y luego cada vez que oprimes el botón lo incrementas en 1; en la próxima respuesta te paso el código modificado (incluso al inicio de tu procedimiento veo que vuelves a cargar el formulario y esto lo puedes evitar)

Logré hacer funcionar un formulario de ingreso con user/pass, es el siguiente:
Cree un formulario con dos textbox, uno para el user y otro para el password. El botón comando tiene el siguiente código:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If TextBox1 = Empty Or TextBox2 = Empty Then
ing_datos = MsgBox("Ingrese los datos faltantes", vbCritical, "Faltan datos")
End If
Sheets("hoja1").Select
Cells(1000, 51) = TextBox1
Cells(1000, 52) = TextBox2
Unload UserForm1
end sub
Y la macro que llama al formulario:
Sub Acceso()
Dim user(100) As String
Dim pass(100) As String
user_max = 25 'Usuarios máximos registrados
Sheets("hoja1").Unprotect Password:="restringido"
'Evita el ingreso si previamente se intento entrar repetidas veces con user/pass incorrectos
'Lo que hace es estar definir un tiempo (ver final) para permitir el nuevo login
If Date >= Cells(1000, 49) And Cells(1000, 49) <> Empty Then
If Date = Cells(1000, 49) And Time < Cells(1000, 50) Then 'Tiene que ser superior a X hora
no_permitido = MsgBox("Por seguridad por el momento no se le permite ingresar", vbCritical, "Seguridad")
ActiveWorkbook.Close savechanges:=False
Exit Sub
End If
Cells(1000, 49) = Empty 'Borra fecha del intento anterior de acceso forzado
Cells(1000, 50) = Empty 'Borra hora del intento anterior de acceso forzado
End If
'Ubicación del directorio con los user/pass
directorio = "D:\Login\"
nomb_arch_claves = "claves.xls"
Workbooks.Open Filename:=directorio + nomb_arch_claves, Password:="restringido"
claves = ActiveWorkbook.Name
For fila = 1 To user_max
If Cells(fila, 1) = Empty Then Exit For
user(fila) = Cells(fila, 1)
pass(fila) = Cells(fila, 2)
Next
Windows(claves).Close
For intento = 1 To 5 'Intentos máximos de acceso permitidos
Load UserForm1
UserForm1.Show
user_ing = Cells(1000, 51)
pass_ing = Cells(1000, 52)
For fila = 1 To user_max
If user(fila) = user_ing And pass(fila) = pass_ing _
And user_ing <> Empty And pass_ing <> Empty Then
Cells(1000, 51) = Empty 'Borra user
Cells(1000, 52) = Empty 'Borra pass
Sheets("hoja1").Protect Password:="restringido"
'Aca va lo que ejecuta una vez autorizado el ingreso
Sheets("hoja2").Select
Range("a1").Value = "OK"
Unload UserForm1
Exit Sub
End If
Next
mal_ingreso = MsgBox("Usuario o contaseña incorrectos", vbCritical, "Error")
Unload UserForm1
Next
max_intentos = MsgBox("Máximo número de intentos permitidos", vbCritical, "Error")
hora = Hour(Now())
Min = Minute(Now())
Seg = Second(Now()) + 30
hora_sig_int = TimeSerial(hora, Min, Seg)
dia_ult_int = Date
Cells(1000, 50) = hora_sig_int
Cells(1000, 49) = dia_ult_int
Cells(1000, 51) = Empty
Cells(1000, 52) = Empty
Sheets("hoja1").Protect Password:="restringido"
ActiveWorkbook.Close savechanges:=True
End Sub
Una duda, como puedo hacer para que el valor de los textbox me lo pase a la macro, ¿sin tener que grabarlo en una celda en particular?
Saludos
Juan

Te paso el código (incluí uno para el formulario)
Private Sub CommandButton1_Click()
Dim user(100) As String
Dim pass(100) As String
Application.ScreenUpdating = False
If Cells(1000, 50) > Time Then
no_permitido = MsgBox("Por seguridad por el momento no se le permite ingresar", vbCritical, "Seguridad") 'Agregar comprobar fecha
ActiveWorkbook.Close
Else
Cells(1000, 50) = Empty
End If
If TextBox1.Text = "" Or TextBox2.Text = "" Then
ing_datos = MsgBox("Ingrese los datos faltantes", vbCritical, "Faltan datos")
TextBox1.SetFocus
Exit Sub
' Unload UserForm1 'Es mas eficiente (incluso en memoria)
' Load UserForm1
' UserForm1.Show
End If
Workbooks.Open Filename:="claves.xls", Password:="prueba"
claves = ActiveWorkbook.Name
For fila = 1 To 5
user(fila) = "fgabdfjasdhfjasndf"
pass(fila) = "fgabdfjasdhfjasndf"
Next
For fila = 1 To 5
If Cells(fila, 1) = Empty Then Exit For
user(fila) = Cells(fila, 1)
pass(fila) = Cells(fila, 2)
Next
Windows(claves).Close
Do While Range("Intentos") < 5
For fila = 1 To 5
If user(fila) = TextBox1 And pass(fila) = TextBox2 Then
Sheets("hoja2").Select
Range("a1").Value = "OK"
Unload UserForm1
Exit Sub
End If
Next
mal_ingreso = MsgBox("Usuario o contaseña incorrectos", vbCritical, "Error")
TextBox1.Text = ""
TextBox2.Text = ""
TextBox1.SetFocus
Range("Intentos") = Range("Intentos") + 1
Loop
max_intentos = MsgBox("Máximo número de intentos permitidos", vbCritical, "Error")
hora = Hour(Now())
Min = Minute(Now())
Seg = Second(Now()) + 30
hora_sig_int = TimeSerial(hora, Min, Seg)
Cells(1000, 50) = hora_sig_int
ActiveWorkbook.Close savechanges:=True
End Sub
Private Sub UserForm_Initialize()
Range("Intentos") = 1 'Deberias definir este rango
End Sub

Probé de esta manera, pero sigue estando el inconveniente de que si metes mal el user/pass, el loop no para, no permitiéndote reingresar datos nuevos en los textbox para comprobar el nuevo user/pass. Termina saliendo la macro por máximo intentos repetidos, aunque en realidad solo se probó una sola vez.
A lo que mandaste último le modifique dos cositas nomas. Fíjate, igualmente en el último código que envié. Ese funciona bien, pero lo trabajé distinto. Repartí parte del código en una macro y otra en el formulario. De todas formas quisiera poder hacerlo de de esta forma.
Private Sub CommandButton1_Click()
Dim user(100) As String
Dim pass(100) As String
Sheets("hoja1").Select
If Range("x1") <> 1 Then 'Comprueba si se intento esta vez para evitar repetir todo esto
Application.ScreenUpdating = False
If Cells(1000, 50) > Time Then
no_permitido = MsgBox("Por seguridad por el momento no se le permite ingresar", vbCritical, "Seguridad") 'Agregar comprobar fecha
ActiveWorkbook.Close savechanges:=False
Else: Cells(1000, 50) = Empty
End If
If TextBox1.Text = "" Or TextBox2.Text = "" Then
ing_datos = MsgBox("Ingrese los datos faltantes", vbCritical, "Faltan datos")
TextBox1.SetFocus
Exit Sub
' Unload UserForm1 'Es mas eficiente (incluso en memoria)
' Load UserForm1
' UserForm1.Show
End If
Workbooks.Open Filename:="D:\JPDoc\Aluar\claves.xls", Password:="hola"
claves = ActiveWorkbook.Name
For fila = 1 To 5
If Cells(fila, 1) = Empty Then Exit For
user(fila) = Cells(fila, 1)
pass(fila) = Cells(fila, 2)
Next
Windows(claves).Close
End If
Do While Range("b1") < 5
For fila = 1 To 5
If user(fila) = TextBox1 And pass(fila) = TextBox2 And _
TextBox1 <> Empty And TextBox2 <> Empty Then
Range("x1") = 0
Sheets("hoja2").Select
Range("a1").Value = "OK"
Unload UserForm1
Exit Sub
End If
Next
mal_ingreso = MsgBox("Usuario o contaseña incorrectos", vbCritical, "Error")
**********************************
'Aca esta el problema, no se detiene el loop y no podes cargar nuevos user/pass
TextBox1.Text = ""
TextBox2.Text = ""
TextBox1.SetFocus
Range("b1") = Range("b1") + 1
Range("x1") = 1
Loop
********************************
max_intentos = MsgBox("Máximo número de intentos permitidos", vbCritical, "Error")
hora = Hour(Now())
Min = Minute(Now())
Seg = Second(Now()) + 30
hora_sig_int = TimeSerial(hora, Min, Seg)
Cells(1000, 50) = hora_sig_int
Range("x1") = 0
ActiveWorkbook.Close savechanges:=True
End Sub
Private Sub UserForm_Initialize()
Range("b1") = 1 'Deberias definir este rango
End Sub
Saludos y muchas gracias
Juan

Funciono perfecto gustavo, era ese loop como decías vos. Muchas gracias por la ayuda. Envío el código completo terminado y funcionando para que lo puedan usar si les interesa:
Private Sub CommandButton1_Click()
Dim user(100) As String
Dim pass(100) As String
Sheets("hoja1").Unprotect Password:="clave"
Sheets("hoja1").Select
Application.ScreenUpdating = False
'on error resume next
If Cells(1000, 50) > Time And Date = Cells(1000, 49) Then
no_permitido = MsgBox("Por seguridad por el momento no se le permite ingresar", vbCritical, "Seguridad") 'Agregar comprobar fecha
ActiveWorkbook.Close savechanges:=False
Else: Cells(1000, 50) = Empty And Cells(1000, 49) = Empty
End If
If TextBox1.Text = "" Or TextBox2.Text = "" Then
ing_datos = MsgBox("Ingrese los datos faltantes", vbCritical, "Faltan datos")
TextBox1.SetFocus
Exit Sub
End If
max_user = 50 'Máximo numero de usuarios registrados
'Los user/pass los guardo en una hoja oculta o en un archivo adicional
'Si la guado en una hoja oculta
Sheets("hoja3").Visible = True
Sheets("hoja3").Select
'Si la guardo en un archivo adicional
'Workbooks.Open Filename:="D:\claves.xls", Password:="hola"
'claves = ActiveWorkbook.Name
For fila = 1 To max_user
If Cells(fila, 1) = Empty Then Exit For
user(fila) = Cells(fila, 1)
pass(fila) = Cells(fila, 2)
Next
Sheets("hoja3").Visible = xlVeryHidden
'Windows(claves).Close
Sheets("hoja1").Select
max_intentos = 5
'Comprobación de la clave
If Cells(1000, 51).Value <= max_intentos Then
For fila = 1 To max_user
If user(fila) = TextBox1 And pass(fila) = TextBox2 And _
TextBox1 <> Empty And TextBox2 <> Empty Then
'***************************************************
'Aca va el las líneas de código que resultan despues de haber sido autorizado el ingreso
Sheets("hoja1").Protect Password:="clave"
Sheets("hoja2").Select
Range("a1").Value = "OK"
Unload UserForm1
'***************************************************
Exit Sub
End If
Next
mal_ingreso = MsgBox("Usuario o contaseña incorrectos", vbCritical, "Error")
TextBox1.Text = ""
TextBox2.Text = ""
TextBox1.SetFocus
End If
'Cuenta un intento fallido de acceso
Cells(1000, 51) = Cells(1000, 51) + 1
Sheets("hoja1").Protect Password:="clave"
Sheets("hoja1").Select
'Chequea numero de intentos actuales
If Cells(1000, 51) > max_intentos Then
max_intentos = MsgBox("Máximo número de intentos permitidos", vbCritical, "Error")
hora = Hour(Now())
Min = Minute(Now())
Seg = Second(Now()) + 30
hora_sig_int = TimeSerial(hora, Min, Seg)
Cells(1000, 49) = Date
Cells(1000, 50) = hora_sig_int
ActiveWorkbook.Close savechanges:=True
End If
End Sub
Private Sub TextBox1_change()
End Sub
Private Sub UserForm_Initialize()
Sheets("hoja1").Unprotect Password:="clave"
Cells(1000, 51) = 1 'Define 1 como el primer intento de acceso
End Sub
Saludos
Juan