Hola tengo una demo, cuando llega a la fecha establecida me pide una clave, pero si repito a la misma fecha anterior se habilita

Cuando dices: "aunque devuelva la fecha en la PC", te refieres a que estamos a 22 de agosto, la fecha máxima en la macro es 20 de julio, entonces la macro te tiene que pedir la clave, ¿correcto?

Lo que hace es cambiar la fecha en la pc, ¿correcto? En la pc pones 10 de julio, esa fecha es menor a 20 de julio entonces la aplicación no te pide clave, ¿correcto?

Para resolver lo anterior podemos intentar lo siguiente:

1. Crea un archivo excel, a ese archivo le pones password: "pass"

2. En la celda "A1" de archivo pass pones la fecha de hoy: 22 de agosto de 2014

3. Guardas el archivo pass. Si tienes dudas, te anexo mi archivo pass y lo pones en la misma ruta en donde tienes tu archivo con la macro.

https://www.dropbox.com/s/8a0rfer341cy91t/pass.xlsx 

Lo que va a hacer la macro es abrir el archivo pass, tomar la fecha de la celda A1, si la fecha es mayor a la fecha de la pc, significa que la fecha de la pc fue alterada, entonces envía un mensaje "la fecha de la pc fue alterada" y se cierra excel.

Cuando termines de usar el userform9, la macro abrirá el archivo pass y cambiará la fecha de la celda A1 por la fecha del día de hoy, de esta forma en el archivo tendrás la fecha actual y si vuelven a alterar la fecha de la pc enviará el mensaje.

Sub abrir()
'
    Dim fec As Date
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Workbooks.Open "pass", Password:="pass"
    fechaanterior = Range("A1")
    Workbooks("pass").Close
    If Date < fechaanterior Then
        MsgBox "la fecha de la pc fue alterada"
        Application.DisplayAlerts = False
        Application.Quit
        Exit Sub
    End If
    fec = "20/07/2013"
    If Date >= fec Then
        clave = InputBox("El tiempo ya expiró. Ingresa clave: ")
        If clave = "" Then Exit Sub
        If clave <> "abc" Then
            MsgBox "Clave incorrecta, no se puede iniciar la aplicación", vbCritical, "Contacte al Administrador del  Sistema"
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            Application.Quit
            Exit Sub
         End If
    End If
    For Each h In Sheets
        h.Unprotect "asd"
    Next
    UserForm9.Show
    For Each h In Sheets
        h.Protect "asd"
    Next
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Workbooks.Open "pass", Password:="pass"
    Range("A1") = Date
    Workbooks("pass"). Save
    Workbooks("pass"). Close
    Application. Quit
End Sub

Prueba y dime cómo se comporta

Hola:

Dam: Cuando dices: "aunque devuelva la fecha en la PC", te refieres a que estamos a 22 de agosto, la fecha máxima en la macro es 20 de julio, entonces la macro te tiene que pedir la clave, ¿correcto?

Yo: La fecha máxima en la macro es el 20/08/2014. Cuando digo "aunque devualva la fecha de la PC", me refiero a que si el periodo que establasi en el código por ejemplo se comprende entre la fecha mínima el 20/07/2014 hasta la fecha máxima 20/08/2014, que la macro trabaje este este periodo sin pedir la clave, pero si se cumplió este periodo y yo quisiera devolver la fecha de la pc nuevamente a la fecha mínima =>20/07/2014, la macro no permita, lo que quiero es que la macro no me permita repetir periodos que ya se cumplieron. Porque sucede que actualmente yo establezco una fecha en el código por ejemplo minima=> 20/07/2014 a máxima => 20/08/2014 y cumplido este periodo de fechas, cambio otra vez la fecha en la pc a la mínima =>20/07/2014, la macro se habilita otra ve y no me pide la clave.

Ya realice el procedimiento que usted me dijo, cree el archivo lo puse en la misma carpeta donde tengo la aplicación, cuando lo corrí por primera ves me pidió la clave, me funciono, luego que cerré la apliocacion y la volví a correr me aparece un error 1004 en tiempo de ejecución, luego probé bajando el que usted me envío de este link, https://www.dropbox.com/s/8a0rfer341cy91t/pass.xlsx, pero me sigue dando el error. Lo uotro es preguntarle con este metodo como establecer los periodos sin que me pida la clave hasta llegar a la fecha maxima. Quedo atento a sus comentarios, muchas gracias.

El periodo está bien en la macro. Lo que intento establecer es si modificaron la fecha de la pc.

Cuando te ocurre el error, en qué línea de la macro se detiene.

 Hola, la se detetiene en la linea 5 esta => (Workbooks.Open "pass", Password:="pass"), este error me ocurre cuando cambie la fecha en la PC, primero me aparece el mensaje que la fecha de la pc fue alterarda, perfecto, luego cerre la aplicacion y cuando volvi abrirla me sale este error 1004 en tiempo de ejecucion. Quedo atento a sus comentarios. ¡Gracias!  

Revisa que el archivo no este abierto y que se encuentre en la misma ruta del archivo con la macro

Hola el archivo esta cerrado y esta en la misma ruta de la macro, osea ambos están en la misma carpeta. Gracias

Cambia esa línea por esta

Workbooks.Open ThisWorkbook.Path & "\pass.xlsx", Password:="pass"

Hola, si con esta línea de código si me funciona perfectamente, pero al parecer cuando termino de usar el userform9, la macro no esta abriendo el archivo pass y no esta cambiando la fecha de la celda A1 por la fecha del día de hoy, osea por la fecha actual, me esta pasando que establezco la fecha de hoy 28/08/2014 en el archivo pass y en la macro una fecha futuro 28/09/2014, cuando se cumple la fecha futuro, la macro me pide la clave, bien, pero si cambio la fecha en la pc a la 31/08/2014  la macro me permite ingresar a la aplicación sin la clave. Lo otro que también me esta fuccionando es que al devolver a una la fecha < que del archivo pass, me sale el mensaje que la fecha de la pc fue alterada, perfecto. Solo me faltaría que cumplida la fecha establecida en la macro, no me permita regresar aunque cambie la fecha de la pc. Muchas gracias

Hola, Dam, le dejo esta macro para QUE ME DE Su VISTO BUENO Y EN LO POSIBLE ME AYUDE A MODIFICARLA, ALGO ASÍ TAMBIÉN ME SERVIRÍA PARA IMPLEMENTARLO EN MI PEQUEÑANA APLICACIÓN. Gracias

Private Sub Workbook_Open()

Call caducidad

End Sub

Sub Eliminar_archivo()

Application.DisplayAlerts = False

ActiveWorkbook.ChangeFileAccess xlReadOnly

Kill ActiveWorkbook.FullName

ThisWorkbook.Close False

End Sub

Sub caducidad()

'deshabilitamos boton cancelar del msgbox

Application.EnableCancelKey = xlDisabled

fecha = Range("f6").Value

If Date < DateSerial(Year(fecha), Month(fecha), Day(fecha)) Then

MsgBox "Dentro de: " & (DateSerial(Year(fecha), Month(fecha), Day(fecha)) - Date) & " dias este archivo se AUTOLIMINARA" & Chr(13) & "Visita Excel Negocios - www.excelnegocios.com", vbInformation, "Tiempo de Expiración"

Else

MsgBox "Lo siento, el tiempo de prueba a terminado." & Chr(13) & "Este archivo se autoeliminará." & Chr(13) & "Visita Excel Negocios - www.excelnegocios.com", vbCritical, "Tiempo de Expiración"

Call Eliminar_archivo

End If

End Sub

Si la macro cumple con lo que necesitas, pues adelante, si quieres algún cambio con gusto te ayudo.

Te anexo la macro con el archivo pass, le hice unos ajustes.

Sub abrir()
'Por.Dante Amor
    Dim fec1 As Date
    Dim fec2 As Date
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableCancelKey = xlDisabled
    '
    fechaactual = Date
    Workbooks.Open ThisWorkbook.Path & "\pass.xlsx", Password:="pass"
    fechaanterior = Range("A1")
    Workbooks("pass").Close
    '
    If Date < fechaanterior Then
        MsgBox "la fecha de la pc fue alterada"
        Application.DisplayAlerts = False
        'Application.Quit
        Exit Sub
    End If
    '
    fec1 = "15/08/2014"
    fec2 = "25/08/2014"
    If Not (fechaactual >= fec1 And fechaactual <= fec2) Then
        clave = InputBox("El tiempo ya expiró. Ingresa clave: ")
        If clave = "" Then Exit Sub
        If clave <> "abc" Then
            MsgBox "Clave incorrecta, no se puede iniciar la aplicación", vbCritical, "Contacte al Administrador del  Sistema"
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            Application.Quit
            Exit Sub
         End If
    End If
    '
    Workbooks.Open ThisWorkbook.Path & "\pass.xlsx", Password:="pass"
    Range("A1") = fechaactual
    Workbooks("pass").Save
    Workbooks("pass").Close
    '
    For Each h In Sheets
        h.Unprotect "asd"
    Next
    UserForm9.Show
    For Each h In Sheets
        h.Protect "asd"
    Next
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Quit
End Sub