Password con macro Para inicio de un formulario en Excel
Tengo esta macro que DAM dejo a un usuario,
Sub PedirClave()
'Por Dante Amor
Do While True
res = InputBox("Escribe la contraseña: ", "INGRESO")
If res = "abc" Then
Exit Do
Else
If MsgBox("Contraseña errada. Intentar de nuevo", vbYesNo, "SEGURIDAD") = vbNo Then
Exit Sub
End If
End If
Loop
End Sub¿Qué pretendo?
Que me funcione de la siguiente manera, para usarla en varios formularios
Private Sub UserForm_Initialize()
Call PedirClave
'Codigo
End Sub
Lo malo es que la coloco en un modulo y funciona de la siguiente manera:
Coloco el passw mal prepositadamente y si en el mensaje del MsgBox le digo No, abre de todas formas el formulario, si le digo SI continua pidiendo la clave, este ultimo es correcto.
Si coloco la Call pedir_clave en
Sub busc_Client()
PedirClave
BuscaClientes.Show
End Sub
sucede lo mismo
¿Cómo se podría corregir el detalle para que si le digo SI, me siga pidiendo la clave, si le digo No se cierre la sección sin que abra al formulario.
= vbNo Then
Exit Sub
Esto que contiene la macro, es precisamente que si le digo No se salga del proceso sin que abra el formulario
2 Respuestas
Lo que vendría mejor en este caso es una función.
Pon el siguiente código en un módulo:
Function PedirClave()
'Por.Dante Amor
Do While True
res = InputBox("Escribe la contraseña: ", "INGRESO")
If res = "abc" Then
PedirClave = True
Exit Do
Else
If MsgBox("Contraseña errada. Intentar de nuevo", vbYesNo, "SEGURIDAD") = vbNo Then
PedirClave = False
Exit Do
End If
End If
Loop
End FunctionAhora en tu formulario o en cada formulario, el código debe quedar así:
Private Sub UserForm_Initialize() 'Por.Dante Amor If PedirClave Then 'Codigo Else End End If End Sub
Saludos.Dante Amor
Recuerda valorar la respuesta.
Todo lo anterior a millón, bien todo
Solo un detalle DAM
Si digo Cancelar en el ImputBox, el MsgBox vuelve y me dice, Contraseña errada vuelva bla bla.
Se entiende que si cancelo debería dar por termino el proceso y cerrarse el Input si más nada decir n ipreguntar
Te anexo la función actualizada
Function PedirClave()
'Por.Dante Amor
Do While True
res = InputBox("Escribe la contraseña: ", "INGRESO")
If res = "abc" Then
PedirClave = True
Exit Do
ElseIf res = "" Then
PedirClave = False
Exit Do
Else
If MsgBox("Contraseña errada. Intentar de nuevo", vbYesNo, "SEGURIDAD") = vbNo Then
PedirClave = False
Exit Do
End If
End If
Loop
End FunctionRecuerda valorar
Si pones exit do y después buscarclientes.show, ya no se ejecuta la instrucción buscarclientes.show, porque obviamente con exit do se va al final del ciclo.Te recomiendo realizar pruebas antes de entregar la respuesta. Saludos - Dante Amor