Como crear un Formulario para Contraseña
Tengo el siguiente código, el cual me despliega un InputBox como parte de un Workbook_Open() donde se debe ingresar un código único (Val), que se pega en una celda oculta ("D6"), por fórmula hace Vlookup y muestra información específica para ese código único.
Dim Val As String Val = InputBox("Ingrese su Clave, por favor:", "Acceso", "Escriba su Clave aquí") MsgBox "Bienvenidos al Resumen de Prestación del Servicio de Asistencias." & vbNewLine & vbNewLine & "Buenos Días" Sheets("MENU").Select Range("D6").Select ActiveCell.FormulaR1C1 = ValHasta ahí funciona a la perfección, los problemas son los siguientes:
1) El Contenido del InputBox quisiera verlo encriptado
2) Si no se modifica el [Default] igual muestra el MsgBox, sería mejor mostrar un error que indique obligatoria la modificación del contenido
3) Si se cancela el InputBox, mostrar un error que indique que es necesario el ingreso de un código, y vuelva a mostrar el InputBox
4)Si el contenido está vacío o no existe en la base de códigos, mostrar un error que indique código inválido y vuelva a mostrar el InputBox hasta que se ingrese un código correcto
4) Solo entonces, deberá mostrar el MsgBox
1 respuesta
Con el InputBox no tienes opción a poner la entrada encriptada, tendrías que usar un TextBox y un botón para aceptar, o bien conformarte con el Inputbox sin cifrar.
Como no explicas donde están los códigos que aceptas como válidos, no puedo orientar mejor la rutina de validación; si nos lo aclaras vemos qué podemos hacer. De momento, busca en el rango A1:A20 un valor que te dará paso a la aplicación.
El resto del código viene a ser algo así:
Dim val As String
val = InputBox("Inserte clave")
If val = "" Then
MsgBox ("Repita código") ' Si se da a Cancelar, o Aceptar en vacío, pide repetición.
CommandButton1_Click
Else
'----------------------------
'Buscar en la base de códigos
'----------------------------
If Not Range("A1:A20").Find(val, LookIn:=xlValues) Is Nothing Then
MsgBox ("Bienvenido")
Sheets("MENU").Select
Range("D6").Select
ActiveCell.FormulaR1C1 = val
Else
MsgBox ("Código incorrecto")
CommandButton1_Click
End If
End If
- Ponlo en el Workbook_Open() sustituyendo a tu código.
Sustituye la línea
If Not Range("A1:A20").Find(val, LookIn:=xlValues) Is Nothing Thenpor
If Not Range("A1:A20").Find(val, LookAt:=xlWhole) Is Nothing Then(fallo mío, por correr, jejeje)
Los códigos válidos se encuentran en la hoja VAL en el rango s2:s51 pero ya lo modifique. Sin embargo, la línea
CommandButton1_Click
después del primer MsgBox, me da "error de compilación: no se ha definido Sub o Function"
Cierto, cierto, yo creé la macro para que se ejecutase en un botón, en el Workbook_Open quedaría así:
Dim val As String
val = InputBox("Inserte clave")
If val = "" Then
MsgBox ("Repita código") ' Si se da a Cancelar, o Aceptar en vacío, pide repetición.
Workbook_Open
Else
'----------------------------
'Buscar en la base de códigos
'----------------------------
If Not Range("A1:A20").Find(val, LookIn:=xlValues) Is Nothing Then
MsgBox ("Bienvenido")
Sheets("MENU").Select
Range("D6").Select
ActiveCell.FormulaR1C1 = val
Else
MsgBox ("Código incorrecto")
Workbook_Open
End If
End Ifdonde aparece
Y para corregir el rango, quedaría algo así
If Not Worksheets("VAL").Range("S2:S51").Find(val, LookIn:=xlWhole) Is Nothing Then
