Fecha de caducidad de libro excel, y reactivacion

[Visor]

Buscando por la red encontré algunas iniciativas de macros para colocar fecha de caducidad, en un caso solo esta programada y cuando se ha cumplido la fecha sale un mensaje de aviso y luego ya no se puede volver a abrir (al menos para los menos avanzados).

Const DateEnd As Date = "20/04/2016"
If Date > DateEnd Then
MsgBox "Fecha caducada,"
ThisWorkbook.Close
Exit Sub
End If

En este caso para alargar el tiempo le cambian la fecha al windows  y listo se puede abrir.

Para evitar esto se ha diseñados entonces así:

 Const DateInicio As Date = "10/04/2016" 'Fecha de Instalación de la Hoja.
     Const DateEnd As Date = "31/08/2016"    'Fecha en la que quiero ponerle fin.

     If Date < DateInicio Or Date > DateEnd Then
          MsgBox "Fecha caducada"
          ThisWorkbook.Close (False) 'Cierra el libro sin guardar los cambios.
          Exit Sub
     End If

En otro caso se hace que al cumplirse la fecha directamente pide una contraseña y si no la tiene entonces se cierra el libro.

En otros casos se prevee agregarle también un contador de días faltantes?, osea que me mande un mensaje notificando cuantos días quedan antes que caduque el libro y ademas me muestre el e-mail del autor o proveedor del libro, para que sea contactado en caso de que requieran el codigo de activación definitivo o les interese comprar un poco mas de tiempo

pero esto ultimo no ha tenido una respuesta que cumpla lo mencionado

ejemplo esta que solo lo ue hace es recordar la fecha de caducidad

Private Sub Workbook_Open()
Dim FechaCaducidad As Date
 
FechaCaducidad = #8/10/2016#
 
    If FechaCaducidad > Date Then
        MsgBox "Faltan " & FechaCaducidad - Date & " días para su caducidad", vbInformation
    Else
        MsgBox "Lo sentimos, pero este libro de trabajo" & vbCrLf & "ha llegado a su fecha de vencimiento", vbCritical
             
            Application.DisplayAlerts = False
            ActiveWorkbook.ChangeFileAccess xlReadOnly
            Kill ActiveWorkbook.FullName
            ThisWorkbook.Close
    End If
End Sub

 

 

Algo asi seria suficiente:

Private Sub Workbook_Open()

    Const DateEnd As Date = "10/05/2016"
    If Date > DateEnd Then
    MsgBox "Fecha caducada, para abrir elarchivo ingrese la contraseña"
    userformIngresodeContraseña.Show 'Entonces le pida la contraseña
    ThisWorkbook.Close
    Exit Sub
    End If

Tienen un ejemplo conbinado con el userform para pedir en ese caso la contraseña de activación

Gracias anticipadas

[Antoni]

Recuerda que, simplemente manteniendo la tecla Shift pulsada al abrir el archivo, el procedimiento Workbook_Open(), no se ejecuta. 

[Visor]

Gracias Macro Antonio, Si lo se, tu mismo lo has explicado en otros temas, pero aun así me gustaría combinar la instrucción explicada, pues también se que muchos no conocen ese truco. Es mas se podría poner tres oportunidades, al segundo le alerte que si luego del tercer intento el archivo se perderá, y entonces si lo intenta el archivo tiene un auto eliminación del directorio, luego de borrarse el contenido de las hojas

aquí subo el primer archivo con solo la caducidad,

no pude subir con el foro, pues no se activa el receptor de archivos, disculpad

https://www.dropbox.com/s/fg5hacqm68hz703/Prueba caducidad.xlsm?dl=0

espero lo abras como lo indicas

 

 

[yordin]

Hace 21 horas, Visor dijo:

 combinado con el userform para pedir en ese caso la contraseña de activación

 

hola @Visor como vas amigo yo uso un código parecido en cual tiene una fecha de caducidad, aparte este notifica con una fecha estimada en días antes de caducar al usuario que este se encuentra vencida:

es este : 

Sub licencia()
Dim fecAviso As Date
Dim fecBorra As Date
Dim fecLimit As Date
Dim licUso  As String
Dim i       As Integer

    fecAviso = DateSerial(2016, 12, 31)
    fecBorra = fecAviso + 15
    fecLimit = fecAviso + 15
    For i = 1 To 3
        

        If Date <= fecAviso Then Exit Sub
        
      licUso = InputBox("Introduzca Nueva Licencia,                                        De lo Contrario Contacte a:                                        !Y.M! ", "Creado por: !Y.M!")

        If Date = fecLimit Then
            If licUso <> "17919119" Then
                MsgBox "Error de Licencia!!!, Intente de Nuevo", vbCritical
            Else
           Exit Sub
            End If

        ElseIf Date >= fecBorra Then
            If licUso <> "17919119" Then
                MsgBox "Error de Licencia!!!, Intente de Nuevo", vbCritical, "Creado por: !Y.M!"
            Else
            'ActiveWorkbook.Close
            Exit Sub
            End If

        End If
    Next
    Application.EnableCancelKey = xlErrorHandler
    'On Error Resume Next
    MsgBox "Error de Licencia!!! El Archivo se Cerrara", vbCritical, "Creado por: !Y.M!"
    Application.DisplayAlerts = False
    '    Me.ChangeFileAccess xlReadOnly
        MsgBox "El Archivo se Cerrara", vbCritical, "Creado por: !Y.M!"
     ActiveWorkbook.Close

End Sub

 

descargue tu archivo pero no colocas en ningún lado la clave para desbloquear y entrar, y del modo que dice @Marco Antonio  usando Shift y luego abrir entra normal, jejeje quedo a la espera del que subirás con el userform para cambiar la clave y fecha de caducidad que es lo que me falta a mi en mi macro poder crear la opción de cambiar fecha de caducidad

[Visor]

Saludos gracias por compartir tu código

veo que hay tres fechas

una fecha de aviso  cuando la fecha es mayor a 2016, 12, 31 , quince días después de el siguiente aviso que es limite y quince después es borrar, quiero que me confirmes si esta bien entendido este orden.

Siendo así no comprendo lo del termino limite, en todo caso solo seria semántica, si es el segundo aviso, pues al tercero si activo esto 'ActiveWorkbook.Close prácticamente no dejaría funcionar que seria la parte final, lógicamente si también le incluyo que borre el contenido de las hojas definitivamente así logren abrir ya no encontraran nada.

ahora bien al probar el código colocándole una fecha ya caducada ne sale el input pidiendo la clave le escribo la clave y no se desactiva nada, ingreso tres veces, pero luego sale el mensaje de que se cerrara y luego con el otro mensaje se cierra el archivo.

Ademas con abriendo con shift pulsado no se puede tener acceso al código de la pagina Thisworook ya que mientras este activo el input nada funciona , esto es bueno pero lo malo es que al ingresar el código no lo acepta, sera que es cuestión de formato pues en el código ha de estar como numero pero lo que ingreso en el input lo lee como texto.

 

[yordin]

Hace 20 horas, yordin dijo:

fecAviso = DateSerial(2016, 12, 31)

fecBorra = fecAviso + 15

fecLimit = fecAviso + 15 For i = 1 To 3

la primera fecha es la de vencimiento, la segunda es un plazo de si en 15 días no se ha colocado la nueva licencia se borre el archivo original dejando solo copia pero está incompleta esa parte ya que aun no escribo esa parte del codigo y la tercera es la fecha en la cual avisa q solo quedan 15 dias antes de vencer licencia de uso.

en:

ActiveWorkbook.Close

solo lo ejecuta y cierra el libro si introduces mal la clave de licencia la cual es "17919119" sin comillas, por eso indicaba que me falta agregar la parte de cuando este vencido poder cambiarla a una fecha nueva, en como lo tengo si introduzco la clave una ves vencido tengo q entrar al código vba y poner la fecha en el,  es ahí donde me hace falta

 

[Visor]

Ok aquí te pongo un código en caso de Demo que en una ocasión el maestro Riddle compartió para el caso de abrir por numero de veces al archivo

Dim Clave As Double
Dim ingresos As Double
Clave = 1234
ingresos = 5 
    If Not Me.TextBox1 = "admin" And Not Me.TextBox1 = Clave Then 
If MsgBox("La contraseña no es correcta" & vbCrLf & "Desea intentarlo de nuevo?", vbQuestion + vbYesNo, "Contraseña incorrecta") = vbNo Then ThisWorkbook.Close False
Me.TextBox1.Value = Empty
Exit Sub
End If
If Me.TextBox1.Value = Clave Then
cuenta
If c >= ingresos = True Then
    MsgBox "Supero el limite de usos del programa"
    Me.TextBox1.Value = ""
   Exit Sub
End If

Claro esta que se podría intentar con el input. Ahora,.. en donde combinarle con lo que tu tienes para que funcione el uso de la contraseña y permita ingresar o activar?? Espero que esto nos pueda servir para resolver este tema.

Gracias por mantenerte en el tema

[yordin]

Hace 1 hora, Visor dijo:

ingresos = 5

deja ver que logro inventarme en esta parte me parece meter parte de mi código y modificar, pero respondere el lunes ya que el fin estare sin compu.

[Visor]

Claro esperaré,

Aqui te pongo otro que activa al input solo con clave de ingreso

Private Sub Workbook_Open()
    Application.EnableEvents = True
Call pwd
End Sub

Sub pwd()
Dim pswd As String
pswd = InputBox("Enter password", "Password", "?????")
If pswd <> "swami" Then
MsgBox "Incorrect Password, Macro disabled"
Application.EnableEvents = False
Exit Sub
Else
Application.EnableEvents = True
End If
End Sub

A propósito, este tipo de seguridad no veo como activar el ingreso al codigo macro mientras impide el input activado, he hecho así como dice el Maestro Macro Antonio pero si le doy en aceptar al input todo se cierra y no se tiene acceso al código de la hoja ThisWorkbook como muestro en el post#5

[Héctor Miguel]

hola, a todos !

OJO <-> TIPS...

 

1) NO asumas que el orden de fechas que acostumbras (dd/mm/aaaa) es igual en todos los equipos o para todos los usuarios
- VBA es "us-centric" y se maneja mejor con el orden de mm/dd/aaaa
- incluso para excel es mas sencillo reconocer fechas con el orden aaaa/mm/dd

 

2) te recomiendo que NO utilices un MsgBox/UserForm para avisarle a un usuario que "no esta autorizado a..." (utilizar tu libro ?)
podría pulsar alguna tecla de interrupción del código (como {ctrl}+{pausa/break/interrupción}...) y EVITAR que tu libro se auto-cierre...
con lo cual, este mecanismo de seguridad/protección/... DEJA DE SER FUNCIONAL
haz algunas pruebas y... (ya comentarás si le sigues avisando)

prueba con un código +/- como el siguiente (OJO que debes pulsar {ctrl}+{pausa/break/...} al aparecer el primer mensaje e interrumpir la ejecución del código)

Sub cuadrosDeMensaje()
  MsgBox "pulsa {ctrl} + {break}" & vbCr & "y responde al siguiente mensaje..."
  MsgBox "viste este mensaje ???"
End Sub

saludos,

hector.

[Visor]

Ok voy a revisar es algo que es necesario aprenderlo pues acostumbro a usar dia/mes/año en la mayoria de los programas

Gracias Hector Miguel

[Visor]

En 22/4/2016 at 18:53 , Héctor Miguel dijo:

pulsar {ctrl}+{pausa/break/.

En mi teclado no encuentro aquellas teclas pausa o break 

Si break es lo mismo que Ctrl + Alt +supr esto me lleva al administrador

[AlbertoMs]

Disculpen, pero creo que están ahogándose en un vaso con agua; la solución debe girar en torno a la seguridad del código. He leído las primeras propuestas de macro y me parecen estupendas, pero lamentablemente son fáciles de "hackear". Si quieren ponerle mayor seguridad deben usar un software como vbasafe, que bloquea el acceso a proyectos. Por cierto dicho software no es freeware.

[Visor]

Hace 6 horas, AlbertoMs dijo:

software no es freeware

""