gracias por su respuesta quesiera pedirle su correo para adjuntar mi BASE DE DATOS LOGIN para que pueda analizar
NOTA.- tengo una tabla usuario1 lo que quiero es agregar mas AREAS por ejemplo por lo menos 8 AREAS que cada area abra el formulario correspondiente - ejemplo si es usuario RENTAS abra formulario RENTAS y asi sucesivamente
ESTUCTURA DE AREAS
Usuario CAJA abra formulario CAJA con su password respectivo
Usuario RENTAS abra formulario RENTAS con su password respectivo
Usuario SECRETARIA abra formulario SECRETARIA con su password respectivo
Usuario PERSONAL abra formulario PERSONAL con su password respectivo
Usuario URBANISMO abra formulario URBANISMO con su password respectivo
Usuario GERENCIA abra formulario GERENCIA con su password respectivo
Usuario PATRIMONIO abra formulario PATRIMONIO con su password respectivo
Usuario CAJA1 abra formulario CAJA1 con su password respectivo
Usuario RECURSOS abra formulario RECURSOS con su password respectivo
NOTA.- Me podria enviarme su correo para adjuntar mi BASE DE DATOS LOGIN
'Dim id_acceso As String
Option Compare Database
Dim NumIntentos As Integer
Private Sub CmdEntrar_Click()
Dim auxContraseña As String
'' NumIntentos = 3
'Comprobamos que hay datos en las cajas de texto
If Nz(Me.TxtLogin.Value, "") = "" Then
MsgBox "Seleccione un nombre de usuario de la lista para acceder", vbInformation, "ATENCION"
Me.TxtLogin.SetFocus
ElseIf Nz(Me.TxtPassword.Value, "") = "" Then
MsgBox "Introduzca la contraseña del usuario seleccionado", vbInformation, "ATENCION"
Me.TxtPassword.SetFocus
Else
If Nz(DLookup("Password", "Usuarios1", "Id_usuario=" & Me![TxtLogin]), "") <> "" Then
auxContraseña = DLookup("Password", "Usuarios1", "Id_usuario=" & Me![TxtLogin])
End If
If auxContraseña <> Me.TxtPassword.Value Then
If NumIntentos > 0 Then
NumIntentos = NumIntentos - 1
''MsgBox "Numeros de Intentos realizados: " & NumIntentos
MsgBox "La contraseña introducida es incorrecta" & vbCrLf & _
"Le quedan " & NumIntentos + 1 & " intentos" & vbCrLf & vbCrLf & _
"Por favor, introduzca otra", vbExclamation, "INTRODUCCIÓN INCORRECTA"
Me.TxtPassword.Value = ""
Me.TxtPassword.SetFocus
Else
'' MsgBox "La contraseña introducida es incorrecta" & vbCrLf & _
'' "Le quedan " & NumIntentos & " intentos" & vbCrLf & vbCrLf & _
'' "Por favor, introduzca otra", vbExclamation, "INTRODUCCIÓN INCORRECTA"
'' Me.TxtPassword.Value = ""
'' Me.TxtPassword.SetFocus
MsgBox "Ha superado el numero de intentos", vbCritical, "ADIOS..."
DoCmd.Close acForm, Me.Name 'y cerramos el de acceso
End If
Else
If DLookup("Id_acceso", "Usuarios1", "Id_usuario=" & Me![TxtLogin]) = 1 Then
strUsuario = Me.TxtLogin
' MsgBox "Ha entrado el administrador, mostramos todas las tablas", vbInformation, "BIENVENIDO ADMINISTRADOR"
Call Admin
Else
If DLookup("Id_acceso", "Usuarios1", "Id_usuario=" & Me![TxtLogin]) = 2 Then
strUsuario = Me.TxtLogin
'MsgBox "Ha entrado el Supervisor, mostramos todas las tablas", vbInformation, "BIENVENIDO ADMINISTRADOR"
Call Usuar
Else
' strUsuario = 0
'codigo_user = 0
strUsuario = Me.TxtLogin
'codigo_user = Me.Login_1
'MsgBox "Ha entrado un usuario, ocultamos todas las tablas", vbInformation, "BIENVENIDO USUARIO:" '& strUsuario
Call Pabellon
End If
End If
'DoCmd.OpenForm stDocName, , , stLinkCriteria 'Abrimos el formulario correspondiente
DoCmd.Close acForm, Me.Name 'y cerramos el de acceso
End If
End If
'Me.txtuser = strUsuario
End Sub
Private Sub Form_Load()
''strUsuario = 0
NumIntentos = 2
End Sub
Private Sub btn_duplicar_Click()
'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the subform.
Dim strSql As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.
'Save any edits first
'Guardar todos los cambios primero
If Me.Dirty Then
Me.Dirty = False
End If
'Make sure there is a record to duplicate.
'Asegúrese de que haya un registro de duplicar.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!cod_ambiente = Me.lista_ambiente
'' !fecha = Me.date_fecha
'etc for other fields.
.Update
'Save the primary key value, to use as the foreign key for the related records.
.Bookmark = .LastModified
lngID = !Id_estado
'Duplicate the related records: append query.
If Me.[Estado_subform].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO [DETALLE DE ESTADO] ( Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones ) " & _
"SELECT " & lngID & " As Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones " & _
"FROM [DETALLE DE ESTADO] WHERE Cod_estado = " & Me.Id_estado & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError
If Me.[Nuevo DETALLE Infraestructura].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO [DETALLE INFRAESTRUCTURA] ( Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones ) " & _
"SELECT " & lngID & " As Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones " & _
"FROM [DETALLE INFRAESTRUCTURA] WHERE Cod_estado = " & Me.Id_estado & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError
Else
MsgBox "Advertencia, No se encontró Item's en el Formularaio Infraestructura."
End If
Else
MsgBox "Advertencia, No se encontró Item's en el Formularaio."
End If
'Display the new duplicate.
Me.Bookmark = .LastModified
End With
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdDupe_Click"
Resume Exit_Handler
End Sub
Private Sub btn_equipos_Click()
Me.Estado_subform.Visible = True
Me.Estado_subform.Enabled = True
Me.[Nuevo DETALLE Infraestructura].Enabled = True
Me.[Nuevo DETALLE Infraestructura].Visible = False
btn_mobiliario.Enabled = True
btn_equipos.Enabled = False
End Sub
Private Sub btn_mobiliario_Click()
Me.Estado_subform.Visible = False
Me.Estado_subform.Enabled = False
btn_equipos.Enabled = True
btn_mobiliario.Enabled = False
Me.[Nuevo DETALLE Infraestructura].Visible = True
Me.[Nuevo DETALLE Infraestructura].Enabled = True
End Sub
Private Sub Duplicar_registro_Click()
'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the subform.
Dim strSql As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.
'Save any edits first
'Guardar todos los cambios primero
If Me.Dirty Then
Me.Dirty = False
End If
'Make sure there is a record to duplicate.
'Asegúrese de que haya un registro de duplicar.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!cod_ambiente = Me.lista_ambiente
'' !fecha = Me.date_fecha
'etc for other fields.
.Update
'Save the primary key value, to use as the foreign key for the related records.
.Bookmark = .LastModified
lngID = !Id_estado
'Duplicate the related records: append query.
If Me.[Estado_subform].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO [DETALLE DE ESTADO] ( Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones,Porcentaje ) " & _
"SELECT " & lngID & " As Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones " & _
"FROM [DETALLE DE ESTADO] WHERE Cod_estado = " & Me.Id_estado & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError
If Me.[Nuevo DETALLE Infraestructura].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO [DETALLE INFRAESTRUCTURA] ( Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones,Porcentaje ) " & _
"SELECT " & lngID & " As Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones " & _
"FROM [DETALLE INFRAESTRUCTURA] WHERE Cod_estado = " & Me.Id_estado & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError
Else
MsgBox "Advertencia, No se encontró Item's en el Formularaio Infraestructura."
End If
Else
MsgBox "Advertencia, No se encontró Item's en el Formularaio Equipos."
End If
'Display the new duplicate.
Me.Bookmark = .LastModified
End With
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdDupe_Click"
Resume Exit_Handler
End Sub
Private Sub btn_registro_duplicar_Click()
'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the subform.
Dim strSql As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.
'Save any edits first
'Guardar todos los cambios primero
If Me.Dirty Then
Me.Dirty = False
End If
'Make sure there is a record to duplicate.
'Asegúrese de que haya un registro de duplicar.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!cod_ambiente = Me.lista_ambiente
'' !fecha = Me.date_fecha
'etc for other fields.
.Update
'Save the primary key value, to use as the foreign key for the related records.
.Bookmark = .LastModified
lngID = !Id_estado
'Duplicate the related records: append query.
If Me.[Estado_subform].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO [DETALLE DE ESTADO] ( Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones ) " & _
"SELECT " & lngID & " As Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones " & _
"FROM [DETALLE DE ESTADO] WHERE Cod_estado = " & Me.Id_estado & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError
If Me.[Nuevo DETALLE Infraestructura].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO [DETALLE INFRAESTRUCTURA] ( Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones ) " & _
"SELECT " & lngID & " As Cod_estado, cod_item, total, buen_estado, Mal_estado,Motivo,Observaciones " & _
"FROM [DETALLE INFRAESTRUCTURA] WHERE Cod_estado = " & Me.Id_estado & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError
Else
MsgBox "Advertencia, No se encontró Item's en el Formularaio Infraestructura."
End If
Else
MsgBox "Advertencia, No se encontró Item's en el Formularaio."
End If
'Display the new duplicate.
Me.Bookmark = .LastModified
End With
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdDupe_Click"
Resume Exit_Handler
End Sub
Function Admin()
On Error GoTo Admin_Err
DoCmd.OpenForm "Administrador", acNormal, "", "", , acNormal
Admin_Exit:
Exit Function
Admin_Err:
MsgBox Error$
Resume Admin_Exit
End Function
Function Usuar()
On Error GoTo Usuar_Err
DoCmd.OpenForm "Usuario1", acNormal, "", "", , acNormal
Usuar_Exit:
Exit Function
Usuar_Err:
MsgBox Error$
Resume Usuar_Exit
End Function
Function Pabellon()
On Error GoTo Pabellon_Err
'DoCmd.OpenForm "Usuario2", acNormal, "", "", , acNormal
DoCmd.OpenForm "Usuario3", acNormal, "", "", , acNormal
Pabellon_Exit:
Exit Function
Pabellon_Err:
MsgBox Error$
Resume Pabellon_Exit
End Function