Usuario y contraseñas exactas en Excel VB
Estimados, tengo un archivo excel el cual al abrirlo pide usuario y contraseña, este funciona bien, el problema esta que si agrego una letra que contenta el usuario y/o la contraseña deja entrar o ingreso con un nombre de usuario POR y me deja entrar con la contraseña de otro. ¿Cómo puedo hacer para que el usuario y contraseña sean exactos? Este es el código que uso:
Private Sub ACEPTAR_Click()
user = TBX_USUARIO.Value
Sheets("UserPass").Visible = True
Sheets("UserPass").Select
Range("A1:A8").Select
On Error Resume Next
Set u = Selection.Find(What:=user)
'Selection.FindNext(After:=ActiveCell).Activate
If u Is Nothing Then
MsgBox "Usuario Incorrecto", vbInformation, "Error"
TBX_USUARIO = ""
TBX_CLAVE = ""
TBX_USUARIO.SetFocus
Application.DisplayAlerts = False
Exit Sub
End If
pass = TBX_CLAVE.Value
Range("B1:B8").Select
On Error Resume Next
Set c = Selection.Find(What:=pass)
'Selection.FindNext(After:=ActiveCell).Activate
If c Is Nothing Then
MsgBox "Contraseña Incorrecta", vbInformation, "Error"
TBX_USUARIO = ""
TBX_CLAVE = ""
TBX_USUARIO.SetFocus
Application.DisplayAlerts = False
Else
Sheets("UserPass").Visible = xlSheetVeryHidden
Unload Me
Application.Visible = True
End If
End Sub
Saludos y gracias.
Private Sub ACEPTAR_Click()
user = TBX_USUARIO.Value
Sheets("UserPass").Visible = True
Sheets("UserPass").Select
Range("A1:A8").Select
On Error Resume Next
Set u = Selection.Find(What:=user)
'Selection.FindNext(After:=ActiveCell).Activate
If u Is Nothing Then
MsgBox "Usuario Incorrecto", vbInformation, "Error"
TBX_USUARIO = ""
TBX_CLAVE = ""
TBX_USUARIO.SetFocus
Application.DisplayAlerts = False
Exit Sub
End If
pass = TBX_CLAVE.Value
Range("B1:B8").Select
On Error Resume Next
Set c = Selection.Find(What:=pass)
'Selection.FindNext(After:=ActiveCell).Activate
If c Is Nothing Then
MsgBox "Contraseña Incorrecta", vbInformation, "Error"
TBX_USUARIO = ""
TBX_CLAVE = ""
TBX_USUARIO.SetFocus
Application.DisplayAlerts = False
Else
Sheets("UserPass").Visible = xlSheetVeryHidden
Unload Me
Application.Visible = True
End If
End Sub
Saludos y gracias.
1 Respuesta
Respuesta de calvuch
1
Cero que tu enfoque esta mal orientado, pues utilzias la función buscar y no en forma exacta, pues de esa manera el find te devuelve la coincidencia más próxima y no exacta. Prueba de esta manera:
Dim user As String
Dim pass As String
Dim R As Range
Dim fila As Integer
user = UCase(Trim(TBX_USUARIO))
pass = UCase(Trim(TBX_CLAVE))
fila = Application.WorksheetFunction.CountA(Sheets("UserPass").Range("A:A"))
For Each R In Sheets("UserPass").Range("A1" & ":" & "A" & fila)
If UCase(R) = user Then
If UCase(R.Offset(0, 1)) = pass Then
Unload Me
Application.Visible = True
'aca pones el resto del codigo para el evento que usuario y contraseña sean ok
Exit For
Else
MsgBox "Usuario o Contraseña Incorrecto", vbInformation, "Error"
Exit For
End If
DoEvents
End If
DoEvents
Next
Set R = Nothing
TBX_USUARIO = ""
TBX_CLAVE = ""
On Error Resume Next
TBX_USUARIO.SetFocus
Es más sencillo, pues recorres el rango de la hoja de usuarios hasta que encuentra el usuario exacta y luego si el usuario existe, comprueba la contraseña que se haya en la columna a la derecha, pues bien, una vez que comprueba que usuario y contraseña son los mismos que ingreso el usuario, pues se sale del bucle. Así no sigues recorriendo inútilmente el rango.
Ahora si me permites una opinión, creo que tener usuarios y contraseñas en una hoja dentro del mismo libro que intentas proteger no es lo más adecuado.
Excel (v2007) cuenta con la manera de otorgar accesos controlados mediante usuarios y contraseña cifrados, lo encuentras en la pestaña "Revisar" opción "Permitir que los usuarios modifiquen rangos".
O bien, piensa en alojar la lista de usuarios y password en un archivo externo ( en lo posible cifrado) que luego puedas leer desde excel. No se es mi humilde opinión. En fin
Si te sirve el script que te facilito en esta oportunidad, CIERRA la pregunta.
Bye
Dim user As String
Dim pass As String
Dim R As Range
Dim fila As Integer
user = UCase(Trim(TBX_USUARIO))
pass = UCase(Trim(TBX_CLAVE))
fila = Application.WorksheetFunction.CountA(Sheets("UserPass").Range("A:A"))
For Each R In Sheets("UserPass").Range("A1" & ":" & "A" & fila)
If UCase(R) = user Then
If UCase(R.Offset(0, 1)) = pass Then
Unload Me
Application.Visible = True
'aca pones el resto del codigo para el evento que usuario y contraseña sean ok
Exit For
Else
MsgBox "Usuario o Contraseña Incorrecto", vbInformation, "Error"
Exit For
End If
DoEvents
End If
DoEvents
Next
Set R = Nothing
TBX_USUARIO = ""
TBX_CLAVE = ""
On Error Resume Next
TBX_USUARIO.SetFocus
Es más sencillo, pues recorres el rango de la hoja de usuarios hasta que encuentra el usuario exacta y luego si el usuario existe, comprueba la contraseña que se haya en la columna a la derecha, pues bien, una vez que comprueba que usuario y contraseña son los mismos que ingreso el usuario, pues se sale del bucle. Así no sigues recorriendo inútilmente el rango.
Ahora si me permites una opinión, creo que tener usuarios y contraseñas en una hoja dentro del mismo libro que intentas proteger no es lo más adecuado.
Excel (v2007) cuenta con la manera de otorgar accesos controlados mediante usuarios y contraseña cifrados, lo encuentras en la pestaña "Revisar" opción "Permitir que los usuarios modifiquen rangos".
O bien, piensa en alojar la lista de usuarios y password en un archivo externo ( en lo posible cifrado) que luego puedas leer desde excel. No se es mi humilde opinión. En fin
Si te sirve el script que te facilito en esta oportunidad, CIERRA la pregunta.
Bye
Funciona amigo, pero si no ingreso nada o ingreso con user no registrado, no me dice que el user o contraseña están incorrectas, me limpia los textbox y me deja en el 1. gracias por tu tiempo.
Dim user As String
Dim pass As String
Dim fila As Integer
Dim ex As Boolean
user = UCase(Trim(TBX_USUARIO))
pass = UCase(Trim(TBX_CLAVE))
If Len(user) = 0 Or Len(pass) = 0 Then MsgBox "Ingrese usuario y contraseña", vbInformation: Exit Sub
fila = Application.WorksheetFunction.CountA(Sheets("UserPass").Range("A:A"))
If fila = 0 Then Exit Sub
Dim R As Range
ex = False
For Each R In Sheets("UserPass").Range("A1" & ":" & "A" & fila)
If UCase(R) = user Then
If UCase(R.Offset(0, 1)) = pass Then
ex = True
Unload Me
Application.Visible = True
'aca pones el resto del codigo para el evento que usuario y contraseña sean ok
Exit For
Else
MsgBox " Contraseña Incorrecta", vbInformation, "Error"
Exit For
End If
DoEvents
End If
DoEvents
Next
Set R = Nothing
If ex = False Then MsgBox "Usuario no registrado", vbCritical
TBX_USUARIO = ""
TBX_CLAVE = ""
On Error Resume Next
TBX_USUARIO.SetFocus
Si te sirve el script que te facilito en esta oportunidad, CIERRA la pregunta.
Dim pass As String
Dim fila As Integer
Dim ex As Boolean
user = UCase(Trim(TBX_USUARIO))
pass = UCase(Trim(TBX_CLAVE))
If Len(user) = 0 Or Len(pass) = 0 Then MsgBox "Ingrese usuario y contraseña", vbInformation: Exit Sub
fila = Application.WorksheetFunction.CountA(Sheets("UserPass").Range("A:A"))
If fila = 0 Then Exit Sub
Dim R As Range
ex = False
For Each R In Sheets("UserPass").Range("A1" & ":" & "A" & fila)
If UCase(R) = user Then
If UCase(R.Offset(0, 1)) = pass Then
ex = True
Unload Me
Application.Visible = True
'aca pones el resto del codigo para el evento que usuario y contraseña sean ok
Exit For
Else
MsgBox " Contraseña Incorrecta", vbInformation, "Error"
Exit For
End If
DoEvents
End If
DoEvents
Next
Set R = Nothing
If ex = False Then MsgBox "Usuario no registrado", vbCritical
TBX_USUARIO = ""
TBX_CLAVE = ""
On Error Resume Next
TBX_USUARIO.SetFocus
Si te sirve el script que te facilito en esta oportunidad, CIERRA la pregunta.
