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

Hola Dam, este código de la demo fue diseñado por usted y me esta funcionando perfectamente, ¡gracias!, pero quisiera saber si es posible que esta macro no me permita repetir las fechas que ya paso sin ingresar la clave, sucede que está pasando que en el código pongo la fecha desde el 20/07/2013 hasta 20/08/2014, pero pasado este periodo, devuelvo la fechas en la PC nuevamente al 20/07/2013, la macro se habilita y me permite ingresar a la aplicación sin la clave hasta llegar otra vez al 20/08/2014 y así sucesivamente puedo trabajar con la aplicación por todo un año, devolviendo al mismo periodo de fecha que está establecido en el código, entonces no tendría ningún control sobre mi peque aplicación. Quisiera que, si la fecha ya fue cumplida no me permita ingresar sin la clave, aunque devuelva la fecha en la PC. Le pido disculpas por mi insistencia. Muchas gracias. Le anexo el código. 

fec = "20/07/2013"

If Date <= fec Then

    clave = InputBox("Se cambio la fecha del sistema a un periodo anterior. 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"

     Exit Sub

       End If

End If

  fec = "20/08/2014"

    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.Quit

1 respuesta

Respuesta
1

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

¡Gracias!, estoy muy agradecido con su ayuda, es usted lo máximo, bueno creo que gracias a Dios y a su ayuda he podido terminar mi pequeña aplicación, me faltan algunas cositas que ya no son mayores, me gustaría enviarle la demo para que usted vea todo lo que pude hacer gracias a su valiosa ayuda, si eso es posible por favor deme su correo y le envío la demo. Mil gracias.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas