Formulario acceso y registro listado de usuarios
Encontré una consulta en donde ayudas a un usuario con una macro solo (Cómo registrar el acceso a un archivo excel) me gustaría saber si me puedes ayudar ya que tengo un proyecto similar lo que necesito es que mi macro con formularios de acceso a un listado de usuarios y que registre el acceso de este mismo en otra hoja. Hasta el momento he logrado poco mi macro de acceso si ingreso la contraseña mal aun así da acceso a mi base no encuentro el error, además como que se lleve un record de que usuario del los que que tengo en mi listado ha realizado cambios.
1 Respuesta
Revisa la siguiente respuesta:
Validar espacios vacíos en un userform con limite de validación para un usuario y contraseña
Antes de esta línea en la macro:
UserForm1.Show
Debes guardar los datos de usuario y fecha en una hoja.
Prueba y me vas comentando
Te anexo otros enlaces:
Macro para Login que permita distinguir entre mayúsculas y minúsculas en el nombre de usuario
Como hacer un formulario de login para excel ?
Acceder con nombre de usuario y contraseña
Empieza por adaptar alguna de las soluciones y después vemos cómo registrar cada acceso en una hoja.
Gracias, ya termine esta parte que me hacia falta tuve que desmontar todo
Les comparto el código
Private Sub CommandButton1_Click()
Dim usuario As String
Dim password As Variant
Dim DatoEncontrado
Sheets("Usuario").Visible = True
Sheets("Usuario").Activate
'Sheets("Usuario").Select
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 = "" & Range(DatoEncontrado).Offset(0, -1).Value
Unload Me
Else
MsgBox "La contraseña es inválida", vbExclamation, Blog
End If
End If
Sheets("Usuario").Visible = False
Sheets("Gen").Select
ActiveWorkbook.Save
Dim numConsec As Long
Dim strConsec As String
Range("I2").Select
Selection.NumberFormat = "@"
If IsEmpty(ActiveCell) Then
Range("I2").Value = "00001"
Else
numConsec = Val(Range("I2").Value) + 1
strConsec = Right("00000" & Trim(Str(numConsec)), 5)
Range("I2").Value = strConsec
End If
Dim i As Integer
i = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Sheet1").Cells(i, 1) = Environ("Username")
Worksheets("Sheet1").Cells(i, 2) = Now()
Worksheets("Sheet1").Cells(i, 3) = Val(Range("I2").Value)
Worksheets("Sheet1").Cells(i, 4) = Val(Range("C7").Value)
End sub
*********************************************************************************
Ahora estoy tratando de nombrar un PDF con mi consecutivo
este es mi codigo
Dim pdff As Object
Const pdlocation As String = "Desktop"
Dim szDesktopPath As String
Set pdff = CreateObject("WScript.Shell")
szDesktopPath = pdff.SpecialFolders(pdlocation)
destfile = szDesktopPath & ActiveSheet.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
destfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Alguna sugerencia de donde puedo agregarle el nombre
Saludos.
