enrigula escribió::lol: Hola a toda la comunidad excel acá aporto un aplicativo para que lo utilicen cuando necesiten colocar password a sus trabajos además de ponerles tiempo de caducidad todo en uno, espero les sea de utilidad.
SALUDOS
Ya Instale el código en un desarrollo y al ejecutarse se cumplen todas las características especificas En Tanto a la asignación de usuarios y claves y la caducidad del sistema Etc. el único problema que estoy teniendo es que no se queda abierto el Excel hay que abrirlo de nuevo lo cual genera el mensaje de que ya está abierto el archivo y que si se vuelve a abrir se perderán los cambios
Abría alguna idea para corregir el error o tratar de evitarlo.
envio mas informacion al respecto
TAMBIEN INTENTE CREANDO UN NUEVO LIBRO CON EL NOMBRE DE " DATE " A EFECTOS DE QUE SE QUEDARA ABIERTO EL EXCEL DESPUES DE EJECUTAR EL PASSWORD PERO A LA FECHA SOLO SE ABRE EL OBJETO QUE ES FRMCEDULAS ( QUEDA ABIERTO EL EXCEL PERO NO SE VE )
PUDIERA SER QUE DEBO DE SELECCIONAR EL PROYECTO EN VEZ DEL OBJETO
LO INTENTE PERO SE GENERA UN ERROR DE QUE FALTA EL OBJETO
PASSWORS CODIGO
=================
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
If UCase(TextBox1) <> Label3 Then
'pregunta si la clave es correcta
Incorrecto.Show
TextBox1 = Empty
TextBox1.SetFocus
Else
Password.Hide
ECO.Hide
FRMCEDULAS.Show ES EL OBJETO DE EL PROYECTO
End If
End Sub
Sub INICIO()
FRMCEDULAS.Show ES EL OBJETO DE EL PROYECTO
'Dim iRESPUESTA As Integer
'RESPUESTA = MsgBox("¿DESEAS GUARDAR AHORA TU TRABAJO?", vbYesNoCancel)
'If iRESPUESTA = vbYes Then
'Application.Dialogs(xlDialogSaveAs).Show
'End If
End Sub
Private Sub CommandButton2_Click()
Password.Hide
End Sub
Private Sub ComboBox1_Change()
Application.ScreenUpdating = False
nomusu = ComboBox1.Value
Cells.Find(What:=nomusu, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
fil = ActiveCell.Row
col = ActiveCell.Column
Clave = Cells(fil, col + 1).Value
Label3 = Clave
TextBox1.SetFocus
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
numdat = 4
numdat = numdat + 3
For C = 3 To numdat
ComboBox1.AddItem Range("B" & C).Value
Next C
End Sub
Private Sub FRMCEDULAS_activate() ES EL OBJETO DE EL PROYECTO
TextBox1 = Empty
ComboBox1 = Empty
ComboBox1.SetFocus
End Sub
PERMISO CODIGO
================
Private Sub CommandButton1_Click()
PERMISO.Hide
End Sub
Private Sub CommandButton2_Click()
Application.Quit
End Sub
Private Sub UserForm_Initialize()
' Asegura que la hoja esta activada
Sheets("INICIO").Activate
'Aqui se visualiza el resultado
Me.TextBox1.Value = [A3]
End Sub
CODIGO DE FARCEDULAS
=====================
Private Sub COMMANDBUTTON196_CLICK()
Sheets("DOCTOS").Visible = True
Application.Goto REFERENCE:="AYUDA"
INICIO DEL SISTEMA
=================
Sub INICIO()
FRMCEDULAS.Show
'Dim iRESPUESTA As Integer
'RESPUESTA = MsgBox("¿DESEAS GUARDAR AHORA TU TRABAJO?", vbYesNoCancel)
'If iRESPUESTA = vbYes Then
'Application.Dialogs(xlDialogSaveAs).Show
'End If
End Sub