Simular acceso con usuario y password en Excel con formulario vba

En esta ocasión les comparto un ejemplo donde se simula el acceso a un sistema mediante el ingreso de un Usuario y una Contraseña.

Lo vamos a realizar mendiante un formulario de vba que nos pida y nos valide los siguientes datos:

  1. Que tanto el usuario como la contraseña estén llenos.
  2. Que el usuario ingresado exista en la tabla de usuarios.
  3. Que coincida el usuario ingresado con su contraseña.

Para validar que usuario existe se hace mediante la función COUNT.IF de vba; para elegir al usuario encontrado se hace con el método Find; y por último para validar que el usuario y la contraseña coincidan, se realiza haciendo un Offset de la celda encontrada.

Imagen del formulario de acceso

image

Imagen de la tabla de usuarios

image

Código del formulario

':: By: Sergio Alejandro Campos Hernández
':: Date: marzo de 2012
':: http://exceleinfo.wordpress.com
':: Purpose: simular acceso con usuario y contraseña
'
Private Sub CommandButton2_Click()
Dim usuario As String
Dim password As Variant
Dim DatoEncontrado
Blog = "EXCELeINFO"
UsuarioExistente = Application.WorksheetFunction.CountIf(Range("D3:D12"), _
    Me.txtUsuario.Value)
Set Rango = Range("D3:D12")
If Me.txtUsuario.Value = "" Or Me.txtPassword.Value = "" Then
    MsgBox "Por favor introduce usuario y contraseña", vbExclamation, Blog
    Me.txtUsuario.SetFocus
ElseIf UsuarioExistente = 0 Then
    MsgBox "El usuario '" & Me.txtUsuario & "' no existe", vbExclamation, Blog
ElseIf UsuarioExistente = 1 Then
    DatoEncontrado = Rango.Find(What:=Me.txtUsuario.Value, MatchCase:=True).Address
    Contrasenia = Range(DatoEncontrado).Offset(0, 1).Value
    If Range(DatoEncontrado).Value = Me.txtUsuario.Value And Contrasenia = _
    Me.txtPassword.Value Then
        Range("G2").Value = "Usuario: " & Range(DatoEncontrado).Offset(0, -1).Value
        'Aquí va el código para dar acceso a todo lo que el programador decida
        Unload Me
    Else
        MsgBox "La contraseña es inválida", vbExclamation, Blog
    End If
End If
End Sub

:: Descargar el ejemplo

You may also like...

63 Responses

  1. RAMON VAZQUEZ says:

    te agradezco todas las aportaciones me he convertido en un adicto EMPIRICO de programacion excel es tan hermoso y mas con personas como tu que hacen un gran aporte de antemano mil gracias

  2. Luis Hernandez says:

    Tu blog es excelente, muchas gracias por compartir

    Saludos

    Luis (Chile)

  3. Juan Carlos says:

    excelente, me ha servido de mucha ayuda tus codigos, saludos

  4. hadadeamor says:

    hola Sergio ; una pregunta.. en donde dice que ‘ahi va el codigo que el usuario decida dar acceso.. como que hiria.. ; ya que te comento tengo un libro que kiero implementarle este valioso aporte tuyo, pero las otras macros pequeñas que tengo estan en cada hoja que tengo… mi libro esta conformado por cinco hojas que contienen macros , como puedo hacer..
    saludos..

    • El código que podrías implementar es alguno que te oculte las demás hojas si es que decides que no las vean si no ingresan un password correcto.

      Conforme al código de cada hoja te recomiendo que todas tus macros las pongas en un módulo independiente y las mandas llamar desde cada hoja.

  5. Alejandro Nahuelhual says:

    Hola Sergio, junto con saludarte y agradecerte por el tiempo que dedicas al foro haciendo las cosas complicadas más simple para nosotros, los novatos, bien, mi pregunta es la sgte. Tu VBA esta excelente, sólo necesito que el usuario y clave lo muestre al momento de abrir el archivo, si no encuentra coincidencias, simplemente que no abra nada, a diferencia de ahora, aunque le des cerrar igualmente te deja ver las demas hojas.

    Alejandro Nahuelhual
    Chile

    • Para que se muestre al momento de abrir el archivo, debes especificarlo en el objeto ThisWorkbook con la instrucción:

      Private Sub Workbook_Open()
      UserForm1.Show
      End Sub

      Para que si la contraseña está incorrecta o no, utiliza la siguiente línea como se te acomode mejor:

      Sheets(“Hoja2″).Visible = False

  6. Alejandro Nahuelhual says:

    Sergio, nuevamente yo, jejejeje, pasa que pude hacer lo que te pedi anteriormente, pero ahora me toco ver que si coloco el usuario por error con mayuscula, me da un error 91, el cual me lleva directamente a VBA, la idea es que tampoco lo deje pasar ó que le diga que el usuario es incorrecto, se entiende????, me podrias ayudar con eso?

    Alejandro Nahuelhual

    • Para esto sólo cambia la línea siguiente:

      DatoEncontrado = Rango.Find(What:=Me.txtUsuario.Value, LookAt:=xlWhole, MatchCase:=False).Address

      A la línea anterior solo le agregué LookAt:=xlWhole

      Y mi recomendación es que tanto el texto que tengas en tu tabla como el introducido en el TextBox sea mayúscula o minúscula.

  7. JORGE PALACIOS says:

    Saludos Sergio, soy algo obstinado y trato de pedir ayuda. siento mucho si te inoportuno
    me podrias dar tu opinion sobre mi codigo por favor

    SE ME OCURRIO HACER OTRO FORMULARIO PARA OTRO USUARIO QUE REQUIERE ACCESO PERO CON OTRAS FUNCIONES POR ASI DECIRLO. LO QUE PASA ES QUE ME TOMA COMO SI FUESE EL MISMO QUE EL CODIGO ANTERIORO ME DA ACCESO PERO PASA DERECHO AL MsgBox Y LUEGO ME SACA

    ESTE ES EL CODIGO DEL FORMULARIO EN EL CUAL TENGO LOS BOTONES PARA ABRIR LOS FORMULARIOS DE ACCESO

    Private Sub UserForm_Activate()

    Application.Visible = True

    End Sub

    ESTE ES EL CODIGO DE MI FORMULARIO DE ACCESO

    Private Sub CMBCU1_Click()

    If TXT1.Text = “ADMIN” And TXT2.Text = “ADMIN” Then
    Ingreso = True
    Sheets(“INICIO”).Visible = True
    Sheets(“CLIENTES”).Visible = True
    Sheets(“INVENTARIO”).Visible = True
    Sheets(“PRODUCTOS”).Visible = True
    FRMMENU.Show

    Else
    Ingreso = False
    Sheets(“CLIENTES”).Visible = False
    Sheets(“INVENTARIO”).Visible = False
    Sheets(“PRODUCTOS”).Visible = False

    End If

    Sheets(“INICIO”).Select
    MsgBox (” Ingrese Usuario y Contraseña?”)
    Unload Me

    End Sub

    HASTA AHI REBIEN.

    SE ME OCURRIO HACER OTRO FORMULARIO PARA OTRO USUARIO QUE REQUIERE ACCESO PERO CON OTRAS FUNCIONES POR ASI DECIRLO. LO QUE PASA ES QUE ME TOMA COMO SI FUESE EL MISMO QUE EL CODIGO ANTERIORO ME DA ACCESO PERO PASA DERECHO AL MsgBox Y LUEGO ME SACA

    Private Sub CMBCU3_Click()

    If TXT3.Text = “USER” And TXT4.Text = “USER” Then
    Ingreso = True
    Sheets(“ACCESO ADMINISTRADOR”).Visible = True
    Sheets(“CLIENTES”).Visible = True
    Sheets(“INVENTARIO”).Visible = True
    Sheets(“PRODUCTOS”).Visible = True
    FRMBIENVENIDOADMIN.Show

    Else
    Ingreso = False
    Sheets(“CLIENTES”).Visible = False
    Sheets(“INVENTARIO”).Visible = False
    Sheets(“PRODUCTOS”).Visible = False

    End If

    Sheets(“INICIO”).Select
    MsgBox (” Ingrese Usuario y Contraseña?”)
    Unload Me

    End Sub

    • Según tu código:

      Sheets(“INICIO”).Select
      MsgBox (” Ingrese Usuario y Contraseña?”)
      Unload Me

      Te selecciona la hoja INICIO, te muestra el formulario y después lo cierra. Es correcto el funcionamiento ?

  8. emmxnuel says:

    Gracias! ;) esto me fue de mucha ayuda y no cabe duda q excel no tiene limtes :D

  9. luis ortiz says:

    saludos sergio, sabes me base en tu codigo para poder hacer mi pantalla de acceso, pero por alguna razon no me toma datos en DatoEncontrado no toma el valor de la caja de texto

    ElseIf UsuarioExistente = 1 Then

    DatoEncontrado = Rango.Find(What:=Me.TextBox1.Value, LookAt:=xlWhole, MatchCase:=False).Address

    Contrasenia = Range(DatoEncontrado).Offset(0, 1).Value

    If Range(DatoEncontrado).Value = TextBox1.Value And Contrasenia = TextBox2.Value Then
    Range(“G2″).Value = “Usuario: ” & Range(DatoEncontrado).Offset(0, -1).Value

  10. Manuel Ramirez says:

    Buenas tardes sergio realice una entreda de usuario y contraseña me sucede lo mismo que luis los datos a encontrar son numericos pero me arroja error en esta linea “DatoEncontrado = Rango.Find(What:=Me.TextBox1.Value, LookAt:=xlWhole, MatchCase:=False).Address”.
    que puedo hacer en este caso.

    • Ubica éstas líneas:

      Contrasenia = Range(DatoEncontrado).Offset(0, 1).Value
      If Range(DatoEncontrado).Value = Me.txtUsuario.Value And Contrasenia = _

      Y reemplázalas con éstas:

      Contrasenia = CStr(Range(DatoEncontrado).Offset(0, 1).Value)
      If CStr(Range(DatoEncontrado).Value) = Me.txtUsuario.Value And Contrasenia = _

      Se hace la conversión de número a texto para que funcione con passwords numéricos.

  11. David Franco says:

    Buenos dias Sergio, dos cositas, la priemra es que el link de descarga ya no esta activo, haber si porfavor podrias enviarmelo a este correo: qffranco@gmail.com. Lo segundo es que copie tu codigo pero al ir ejecutandolo por pasos me sale el siguiente error: “erro de compilacion el uso de la palabra me no es valido. Uso excel 2007. Ya he copiados otras macrso con este me y me sale el mismo error, por que otroa propiedad podria reemplazarlo o que puedo hacer?. Por ultimo felicitaciones por compartir sus conocimientos. Muchas gracias.

  12. Antonio says:

    Muchísimas gracias por tus estupendos aportes. El formulario tiene un problema, si le das a “cerrar”, accedes al libro sin necesidad de usuario y contraseña. ¿Cómo se soluciona esto?
    Saludos

    • Sergio Alejandro Campos says:

      El archivo no se cierra para que puedan ver el código y aplicarlo según sus necesidades.

      Si quieres que se cierre el archivo, asignale el siguiente código en el botón cerrar:

      Activeworkbook.Close SaveChanges:=False

  13. angel says:

    buenos dias… muchas gracias por este valioso aporte, tengo una duda… quisiera que lo nombres de usuario fueran numericos y el programa hiciera lo mismo, como se logra esto? gracias de antemano por la respuesta…

  14. Jonathan Zarco says:

    Genial! Justo lo que quería, muchísimas gracias por este enorme aporte, eres todo un crack. :D

  15. David says:

    Se podria hacer esto con una base de datos externa, como access o oracle? me seria de gran ayuda saberlo

  16. Angel De Garibay Flores says:

    men pero si los datos estan en la hoja2 como se tendra que hacer la formula??

    • sergioacamposh says:

      Antes de cada Range especifica la hoja:

      Sheets(“Hoja2″).Range(“G2″).Value

      Y así con todos.

  17. Angel De Garibay Flores says:

    gracias sergio
    diculpa tengo bueno estoy asiendo un formulario pero tengo unas dudas
    si me podrias ayudar con el te lo agradesco este e smi correo
    angelfloresrivera@hotmail.com y te envio el archivo y me dices como esta de bien o de mal jajaj

  18. Angel De Garibay Flores says:

    MUCHAS GRACIAS SERGIO
    SOLO QUE SE PASO DECIRTE QUE EL NUMERO QUE QUEIRO QUE VALIDE ESTAN DESDE LA A2 HASTA LA A100000 SUPONGAS COMO TENGO QUE PONERLE SI SOLO EM AVALIDA EL RANGO QUE PONGO A2 PERO YO KIERO QUE VERIFIQUE DE TODOS LOS NUMEROS QUE TENGO LO BUSQUE Y SI ES CORRECTO PASE AL SIGUIENTE PASO SERIA ASI (“A1:A10000″) ASI NO ES VDAD POR QUE ME PARQUE ERROR
    GRACIAS PRO TU AYUDA

    • sergioacamposh says:

      Usa esto.

      Set MiRango = Sheets(“Hoja2″).Range(“A1:A10000″)

      Cuenta = Application.WorksheetFunction.CountIf(MiRango, Me.TextBox1.Value)

      If Cuenta >= 1 Then
      MsgBox “Duplicado.”
      Else
      MsgBox “Continúa”
      End If

  19. Angel De Garibay Flores says:

    gracias companero como por la nune no entendi eso bueno no se por donde
    y si ya se puedo pero al poner cualquier numero me marca el error asta que no termine deponerlo por que dijo nome deja escribirlo asta que termine como ago para que no pase eso

    • sergioacamposh says:

      Seguro tienes algo así:

      Private Sub TextBox1_Change()
      ‘Código
      End Sub

      El evento Change ejecuta el código cada vez que escribes. Para que no pase asigna el código a un botón.

      • Angel De Garibay Flores says:

        si asi lo tengo ejje entonces lo agrego a un boton para que no pase eso ok tengo otra duda yo quiero conectar una vascula gse a una compu yo kiero con este programa que estoy asiendo quiero jalar la informacion de la vacula cada vez que aplaste el boton de imprimir jale la infomacion como podre hacer eso sergio ?

        • Angel De Garibay Flores says:

          sergio ya agregue el codigo al boton
          pero como ago para que no siga la funcion el boton
          dijo si hay un error no imprima se detenga el proseso

  20. Paola Zamudio says:

    Hola Sergio, tu me podrias por favor ayudar indicandome como puedo hacer para que al realizar el ingreso de usuario y contraseña no se direccione a una hoja diferente al inicio para mi caso la llamaría Administrador.
    Muchas gracias

  21. luis fernando duarte beltran says:

    Sergio he tomado tu aplicacion y la he colocado en una mia, me corre genial, pero al ubicar esta nueva aplicacion en otro pc me sale error de compilacion en el Blog = “EXCELeINFO”, hay una forma para hacer correr esta aplicación.

    • sergioacamposh says:

      Descarga la nueva versión de EXCELeINFO add-in.

      http://blogs.itpro.es/exceleinfo/exceleinfo-add-in/

    • luis fernando duarte beltran says:

      sergio ahora me sale error de aplicacion no se encuentra el proyecto o la biblioteca, me puedes ayudar con este tema que estoy bloqueado, te agradezco en el alma

      • sergioacamposh says:

        Si deshabilidad el add-in te sigue mostrando el error ?

        El error te sale cuando abres Excel o tu archivo ?

        • luis fernando duarte beltran says:

          El error me sale en el archivo cuando lo pongo a correr y al loguearse me sale el error de compilacion.

          • luis fernando duarte beltran says:

            1- Este es el inicio del programa, sale el form de logueo,
            hasta ahí bien, ya que abre excelente.
            2- El error sale cuando digito el usuario y password y me
            bota este pantallazo, de error de
            compilación.
            3- Y al momento de hacer la depuración, me
            envía directamente al Blog = “ExceleInfo”, yo se lo cambie por “C.G.A.”, pero en
            mi portatil si
            corre y muy bien, pero en otro equipo no me corre la aplicación me puedes
            ayudar??.

            Nota: te envio las imagenes de lo que me muestra la aplicación

          • sergioacamposh says:

            Para validar si es esa línea la que genera problemas elimínama o coméntala en la parte de los MSGOBX donde diga Blog ponle tu título entre comillas.

          • sergioacamposh says:

            Compárteme tu archivo darle una mirada por favor.

  22. CESAR says:

    HOLA SERGIO.

    ANTES QUE NADA FELICIDADES POR ESTE GRAN APORTE,
    Y QUISIERA PEDIRTE AYUDITA; DESCARGUE TU BASE DE EXCELeINFO – usuario y contraseña Y CORRE GENIAL
    COPIE TU CODIGO EN UN USERFORM PERO HAS DE CUENTA QUE SI ME VALIDA LO QUE ES EL USUARIO PERO LA CONTRASEÑA ME LA ARROJA INVALIDA
    YA HICE VARIAS PRUEBAS Y NO LOGRA QUEDARME, YA REVISE EL CODIGO PERO NO ENTIENDO POR QUE SI ME VALIDA EL USUARIO Y LA CONTRASEÑA NO
    ESPERO ME PUEDAS AYUDAR BROTHER.

    SALUDOS!

  23. Eric Hernández Rojas says:

    Necesito una macro para modificar una contraseña desde una celda en excel con un formulario

    • sergioacamposh says:

      En lo que podemos apoyamos a la comunidad, pero será primordial que lleves un avance de lo que necesitas y vemos si en algo podemos aportar.

  24. Fernando says:

    Hola Sergio, una maravilla lo que has hecho… Felicitaciones!!! Amigo, pude hacer lo que has hecho replicarlo en mi pequeño proyecto, yo quiero esconder el excel para trabajar, pero al ocultarlo las funciones el VBA no las ejecuta bien y me salen errores… Soy un novato en el tema, pero me gusta mucho y voy por mas… Saludos y eres un GRANDE!!! Gracias por tu generosa ayuda.

  25. Claudia Capillas says:

    Buenos dias disculpa me esta saliendo error 9 y cuando coloco el depurador veo esto Sheets(“Hoja” & i).Visible = xlSheetVisible, revise las hojas y estan como deberia, sera porque las hojas tienen nombre??

    • Raimundo Baravaglio says:

      Si tus hojas tienen nombre, debes ponerlo entre las comillas en lugar de “Hoja”&i.
      O sea, deberías reemplazar:

      Sheets(“Hoja” & i).Visible = xlSheetVisible

      Por:

      Sheets(“Tu Propio Nombre de Hoja”).Visible = xlSheetVisible

      Y esto para cada hoja, porque evidentemente el uso de (“Hoja” & i) suele corresponder a un bucle For que completa automáticamente dichos nombres.

      Saludos!

  26. Claudia Capillas says:

    Hola Sergio, estoy tratando de terminar mi excel, pero tengo unos problemitas, por un lado el error que te comenteantes y por otro lado, agregue la contraseña de administrador y ademas tengo las contraseñas para las otras personas restringidas, lo que me esta pasando es que si abro el de las contraseña de administrador, cuando lo cierro y lo vuelvo a abrir abre todas las paginas sin validarme contraseña. Algo estoy haciendo mal, me podras dar una mano?
    Gracias

  27. Raimundo Baravaglio says:

    Sergio, te agradezco tu aporte. Realmente es muy valioso y me bajé todos los contenidos para después mirar algunas cosas que nunca usé.
    Puntualmente te quería comentar que descargué el código del formulario con contraseña (yo estaba teniendo problemas con un tema relacionado y quería ver si podía resolverlo) y me encontré con que al intentar poner los datos de la primera linea de tu tabla de usuario y clave (Usuario: maria y Clave: Marsta) me arroja error. Esto sólo me pasa con los datos de la primera fila. Usé el resto sin inconvenientes. Intenté hasta “copia y pegar” los datos para evitar errores de tipeo, pero me sigue diciendo que la contraseña es inválida.
    Ignoro el motivo, porque no tuve tiempo de investigar ese punto. Yo uso 2010, no sé si eso tendrá algo que ver. (Lo aclaro por si VBA varía de esta versión a la que hayas usado en tu ejemplo).
    Excelente blog! A favoritos!

  28. JUANITOAPTLACO says:

    OYE PODRIAS AUMENTAR UN BOTON QUE PERMITA CAMBIAR LA CONTRASEÑA

  29. Edu Du says:

    hola ..me gustaria consultyarte tu correo para poder solicitarte ayuda mas especifica..mi correo es edu17_@hotmail.es

  30. Edu Du says:

    Sergio me podrias ayudar con tu direccion de correo ..para poder solicitarte ayuda especifica

  31. Andres Lopez says:

    Hola Sergio no podrias ayudarme, tengo el mismo problema que algunos, me sale error 424 y luego se abre Vba y me sale Depurar, y me sale error lo siguiente.:

    DatoEncontrado = Rango.Find(What:=Me.txtUsuario.Value, MatchCase:=True).Address

    adjunte algunas imagenes para que se entienda mejor mi problema.
    desde ya muchas gracias
    te dejo mi correo por cualquier cosa: Francisco.andres95@gmal.com
    me gustaria que hagas un video tutorial sobre este problema…

Leave a Reply

Your email address will not be published. Required fields are marked *

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

%d bloggers like this: