Jump to content
Sign in to follow this  
hector Arce

Caducidar programa

Recommended Posts

Hola amigos, de antemano Gracias por su atención, mi preguna es: SE PUEDE CODIFICAR UN "programa" para que despues de un tiempo 1 o 2 años ya no pueda ser usado?

yo hice un pequeño programa para un amigo, en BVA Excel y quiero que tenga vencimiento, se puede evitar que lo copien? existe algun programa para hacer esto?, debo estudiar algún lenguaje para hacerlo? alguien me puede ayudar?,

mil gracias, ojalá que alguien sepa como hacerlo...

Share this post


Link to post
Share on other sites

Bueno, una opción podría ser la de proteger la parte del VBA, para que te pida contraseña a la hora que se quiera ver o modificar el código... te adjunto un archivo con los pasos para hacerlo, espero que te sirva... Con respecto con el caducar tu macro... hasta ahorita no eh tenido la necesidad de hacerlo, pero no seria mala idea!...

https://mega.nz/#!oYoSGJqI!y9Re0jHy_Ndi4Qg2ncZ5MdkxvYSbSzAE5UgbLIFc5F0

Saludos!!!...

Share this post


Link to post
Share on other sites

Hola hector Arce,

Esta puede ser otra alternativa

Option Explicit
Public fecAviso As Date
Public fecBorra As Date
Public fecLimit As Date
Public avsUno, avsDos As String
Public verErr As String
Public licUso, licUs2, licUs3 As String
Public Fin As String

Private Sub Workbook_Open()

fecAviso = DateSerial(2013, 4, 1)
fecBorra = fecAviso + 2
fecLimit = fecAviso + 1

If Date <= fecAviso Then Exit Sub
If Date = fecLimit Then GoTo avsUno
If Date = fecBorra Then GoTo avsDos

Application.EnableCancelKey = xlErrorHandler
On Error GoTo verErr

licUso = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
If licUso <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
licUs2 = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
If licUs2 <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
licUs3 = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
If licUs3 <> "ABCD" Then
MsgBox "Error de Contraseña, El Archivo se Borrara"
Application.DisplayAlerts = False
Me.ChangeFileAccess xlReadOnly
Kill Me.FullName
Me.Close False
End If
End If
End If
GoTo Fin

'Gestion del primer aviso
avsUno:
Application.EnableCancelKey = xlErrorHandler
On Error Resume Next
MsgBox "Error de Contraseña ERROR GRAVE !!! El Archivo se Borrara", vbInformation
Application.DisplayAlerts = False
Me.ChangeFileAccess xlReadOnly
' Kill Me.FullName
Me.Close False
MsgBox "EL ARCHIVO SE BORRARA", vbCritical

'Gestion del segundo aviso
avsDos:
Application.EnableCancelKey = xlErrorHandler
On Error Resume Next
MsgBox "Error de Contraseña ERROR GRAVE", vbCritical
Application.DisplayAlerts = False
Me.ChangeFileAccess xlReadOnly
' Kill Me.FullName
Me.Close False
MsgBox "EL ARCHIVO SE BORRARA", vbCritical

'Gestion por Error
verErr:
ActiveWorkbook.Close

Fin:
End Sub
[/CODE]

Puse como texto lo de eliminar archivo para que no te vaya a borrar tu archivo, en fecAviso va la fecha que quieres como caducidad

Mucha Suerte

Saludos !!!

Share this post


Link to post
Share on other sites

El " Kill Me.FullName" aparece mas arriba en el código, pero no como nota... ¿Que es lo que hace?

Option Explicit
Public fecAviso As Date
Public fecBorra As Date
Public fecLimit As Date
Public avsUno, avsDos As String
Public verErr As String
Public licUso, licUs2, licUs3 As String
Public Fin As String
Private Sub Workbook_Open()
fecAviso = DateSerial(2013, 4, 1)
fecBorra = fecAviso + 2
fecLimit = fecAviso + 1
If Date <= fecAviso Then Exit Sub
If Date = fecLimit Then GoTo avsUno
If Date = fecBorra Then GoTo avsDos

Application.EnableCancelKey = xlErrorHandler
On Error GoTo verErr
licUso = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
If licUso <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
licUs2 = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
If licUs2 <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
licUs3 = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")
If licUs3 <> "ABCD" Then
MsgBox "Error de Contraseña, El Archivo se Borrara"
Application.DisplayAlerts = False
Me.ChangeFileAccess xlReadOnly
Kill Me.FullName 'En esta parte que es lo que hace!?
Me.Close False
End If
End If
End If
GoTo Fin[/CODE]

Es que lo vi mas arriba en el código....

Saludos!!!

Share this post


Link to post
Share on other sites

[uSER=160992]@Manuel Franco[/uSER]

El " Kill Me.FullName" aparece mas arriba en el código, pero no como nota... ¿Que es lo que hace?

Digo que esta como texto porque al principio lleva una comilla simple lo que en el editor de Visual es una texto

Saludos !!!

Share this post


Link to post
Share on other sites
Digo que esta como texto porque al principio lleva una comilla simple lo que en el editor de Visual es una texto

Saludos !!!

Si, si, eso si lo se, pero yo, al tratar de entender el código que pusiste, note que había una parte en el código que traía el "Kill me.Fullname", pero sin la comilla simple que lo denota como texto... por eso la intriga de el que es lo que hace esa parte del código... ¿Borra el archivo?, ¿No lo borra?... Perdón por tantas preguntas...

Saludos!...

Share this post


Link to post
Share on other sites

Hola MAX

podrias comenarme estas lineas? para saber donde y como cambiarle la fecha

fecAviso = DateSerial(2015, 9, 1)  'PREGUNTO SI ESTO ES; yyy, mm, dd
fecBorra = fecAviso + 2
fecLimit = fecAviso + 1[/CODE]

Porque le cambio el 1 a 15 y me manda error diciendo ERROR de contraseña ERROR GRAVE sin sequier llegar a pedir la clave

Share this post


Link to post
Share on other sites

Coloque para prueba

fecAviso = DateSerial(2015, 09, 16) ' aqui, despues de cambiar el cursor a otra linea, el cero desaparece, es correcto?
fecBorra = fecAviso + 2
fecLimit = fecAviso + 1[/CODE]

me dice ahora Error de contraseña ERROR GRAVE!!! El archivo se borrara.

Creo que aqui esta bien, porque si le cambio a 2015, 9, 17 no pasa nada, abre normalmente,

YA mañana lo probare a ver si me lo borra.

Tengo alguna que otra macro donde caduca por fecha pero no borra el archivo, solo dice que la fecha de validez caduco, contacte el administrador.

Cualquiera que sepa, puede acesar al codigo aun esté protegido, en caso de que no esté protegido con sabiduria y conocimiento DE EXPERTO

Share this post


Link to post
Share on other sites

[uSER=53155]@JoaoM[/uSER]

Si introduces la contraseña, te deja entrar al archivo, si ves en la macro tienes 3 posibilidades para ingresarla ...

YA mañana lo probare a ver si me lo borra.

Tengo alguna que otra macro donde caduca por fecha pero no borra el archivo, solo dice que la fecha de validez caduco, contacte el administrador

Saludos !!!

Share this post


Link to post
Share on other sites

Mira esta macro

Private Sub Workbook_Open()
'http://www.todoexpertos.com/preguntas/5rv44dmedxnm9vx5/aviso-de-plazo-de-vigencia-de-operatividad-libro?selectedanswerid=5rveqgxs5cmwdyjt&nid=gcqp5uuggnw65g4t9osafsekfwva9ge6goupbxedhjw65&utm_source=todoexpertos.com&utm_medium=Email&utm_campaign=Notification_followeduser_answersolvedaddednotification
'Por.Dante Amor MUY BUENA ESTA
fecini = Date
fecfin = CDate("17/09/2015")
If fecini >= fecfin Then ' SI EL TIEMPO DEL ARCHIVO EXPIRO ENTONCES SE PROTEJE EL ARCHIVO
MsgBox "El tiempo de validez del libro, EXPIRO a: " & fecfin, vbCritical
ActiveWorkbook.Protect "123", Structure:=True, Windows:=True 'cambia el passw por el tuyo
ThisWorkbook.Close True
Exit Sub
End If
'
dif = fecfin - fecini
If dif <= 10 Then 'A LOS 10 DIAS Para EXPIRAR LA FECHA, COMIENZAN LOS AVISOS
MsgBox "El archivo está próximo a vencer. Queda un plazo de: " & dif & " días.", vbExclamation
End If
End Sub[/CODE]

Vete probando cambiar la fecha Ej:. 20/09/2015 y luego retrasala un par de dias

LO que dices sobre el passw, si, así es.

Cuando dice: El archivo se borrará

La verdad es que[color=#b30000][b] NO[/b][/color] lo borra, lo probe y el libro sigue ahí

Tengo 3 macros mas que vencen pero no borran el libro porque así esta en las macros

Pregunto si se puede hacer mas corta la macro

Share this post


Link to post
Share on other sites

El código puede ser así:

Option Explicit
Public fecAviso As Date
Public fecBorra As Date
Public fecLimit As Date
Public licUso As String
Public i As Integer

Private Sub Workbook_Open()
'fecAviso = DateSerial(2015, 9, 16)
fecAviso = DateSerial(2015, 9, 15)
fecBorra = fecAviso + 2
fecLimit = fecAviso + 1
For i = 1 To 3
licUso = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")

If Date <= fecAviso Then Kill Me.FullName 'Exit Sub

If Date = fecLimit Then
If licUso <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
Else
Exit Sub
End If

ElseIf Date = fecBorra Then
If licUso <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
Else
Exit Sub
End If

End If
Next
Application.EnableCancelKey = xlErrorHandler
'On Error Resume Next
MsgBox "Error de Contraseña ERROR GRAVE !!! El Archivo se Borrara", vbInformation
Application.DisplayAlerts = False
' Me.ChangeFileAccess xlReadOnly
' Kill Me.FullName
Me.Close False
MsgBox "EL ARCHIVO SE BORRARA", vbCritical

ActiveWorkbook.Close

End Sub
[/CODE]

Share this post


Link to post
Share on other sites

Hola rolano

Probe tu sugerencia y te cuento:

Al colocar la fecha fecAviso = DateSerial(2015, 9, 11)

me pide clave, no deveria, pues la fecha esta vencida ya y, ademas pide clave, y se la doy ABCD.

Aunque le doy la clave correcta, me dice que invalida, sigue pidiendo hasta la 3ª y luego me dice que invalida y que el libro se borrará pero realmente no se borra.

Aunque la fecha este fecAviso = DateSerial(2015, 10, 11) pide clave al abrir el libro.

Pareciera que esta la macro para que pida clave al abrir el libro y no la funcion de caducidad de fecha para inutilisar el libro o al menos no permitir abrirlo jamas sin que conozca y introduzca la clave por el ente autorisado si la fecha se vence, algo así creo

Share this post


Link to post
Share on other sites

He modificado en esta parte del codigo : ElseIf Date >= fecBorra Then

No se borra por que esta linea esta como comentario Kill Me.FullName

Se supone que tu no sabes que vence el libro. En cualquier programa siempre te pide la clave despues te dice que es erronea. Esta tiene para tres oportunidades.

Option Explicit
Public fecAviso As Date
Public fecBorra As Date
Public fecLimit As Date
Public licUso As String
Public i As Integer

Private Sub Workbook_Open()

fecAviso = DateSerial(2015, 9, 11)
fecBorra = fecAviso + 2
fecLimit = fecAviso + 1
For i = 1 To 3
licUso = InputBox("INTRODUZCA LA LICENCIA DE USO, EL TIEMPO DE VIGENCIA SE HA CADUCADO", "LICIENCIA USO")

If Date <= fecAviso Then Exit Sub


If Date = fecLimit Then
If licUso <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
Else
Exit Sub
End If

ElseIf Date >= fecBorra Then
If licUso <> "ABCD" Then
MsgBox "Error de Contraseña, Intente de Nuevo"
Else
'ActiveWorkbook.Close
Exit Sub
End If

End If
Next
Application.EnableCancelKey = xlErrorHandler
'On Error Resume Next
MsgBox "Error de Contraseña ERROR GRAVE !!! El Archivo se Borrara", vbInformation
Application.DisplayAlerts = False
' Me.ChangeFileAccess xlReadOnly
Kill Me.FullName
Me.Close False
MsgBox "EL ARCHIVO SE BORRARA", vbCritical

ActiveWorkbook.Close

End Sub
[/CODE]

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.
Sign in to follow this  



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png