Como evitar que alterar la fecha de la pc no afecte a la demo
Hola :
Encontré este código tuyo para una demo:
Sub abriruserform1()
'Por.DAM
If Date >= "20/08/2014" 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
Application.Quit
Exit Sub
End If
End If
For Each h In Sheets
h.Unprotect "asd"
Next
UserForm1.Show
For Each h In Sheets
h.Protect "asd"
Next
Application.DisplayAlerts = False
Application.Quit
End Sub
Pero al cambiar la fecha de la pc tranquilamente se bulve a activar la demo como hago que aunque alteren la fecha de la pc esto no afecta a la fecha de la demo. También quisiera que para activar la demo me pida ingresar la dirección del archivo "licencia, txt" la misma que contendría el código de activación.
Agradezco tu gran ayuda.
Y perdona que te moleste pero eres el único que me da soluciones reales.
Gracias
1 respuesta
Disculpa, pero no había visto la pregunta, para que la pueda encontrar más rápido tus preguntas escríbelas en el tema de excel.
Regresando a la pregunta, revisa la siguiente opción. Te anexo el archivo con un formulario Demo.
https://www.dropbox.com/s/oq7ax46hawi1p00/demo%20con%20fecha%20de%20vigencia.xlsm?dl=0
El funcionamiento es el siguiente:
1. En la hoja1, en la celda G1 tienes que poner una fecha, por ejemplo la fecha de hoy: 16/nov/2014
2. Lo que hace la macro es revisar esa fecha contra la fecha de la PC, si la fecha es menor, significa que alteraron la fecha, entonces la aplicación se cierra.
3. La macro revisa la fecha de la G1 contra fecha de la PC y si la fecha de la PC es mayor a 3 días, solicita la clave. Si la clave es incorrecta cierra la aplicación.
4. Si la clave es correcta, verifica el número de ejecuciones. Si la aplicación fue ejecuta más de 3 veces, se cierra la aplicación.
Entonces, si el usuario modifica la fecha de la PC y siempre le pone 16/nov/2014, entonces revisará el número de ejecuciones.
Las macros, en el evento befoclose de workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
Application.ScreenUpdating = False
Sheets("Hoja1").Visible = True
For Each h In Sheets
If h.Name <> "Hoja1" Then
h.Visible = xlVeryHidden
End If
Next
Sheets("Hoja1").Protect "abc"
ThisWorkbook.Save
End SubEn el módulo
Sub abriruserform1()
'Por.DAM
If Date < Sheets("Hoja1").Range("G1") Then
MsgBox "La fecha fue alterada, la aplicación se cerrará", vbCritical, "FIN"
Application.Quit
Exit Sub
End If
'
If Date > Sheets("Hoja1").Range("G1") + 3 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, "FIN"
Application.Quit
Exit Sub
End If
End If
'
If Sheets("Hoja1").Range("G2") > 2 Then
MsgBox "El número de ejecuciones permitidas ya se cumplió", vbCritical, "FIN"
Application.Quit
Exit Sub
End If
'
Application.ScreenUpdating = False
For Each h In Sheets
h.Visible = True
Next
Sheets("Hoja1").Visible = xlVeryHidden
Application.ScreenUpdating = True
'
Sheets("Hoja1").Unprotect "abc"
Sheets("Hoja1").Range("G2") = Sheets("Hoja1").Range("G2") + 1
Sheets("Hoja1").Protect "abc"
UserForm1.Show
'
Application.ScreenUpdating = False
Sheets("Hoja1").Visible = True
For Each h In Sheets
If h.Name <> "Hoja1" Then
h.Visible = xlVeryHidden
End If
Next
ThisWorkbook.Save
Application.Quit
End SubEl password para ingresar y de la hoja1 es "abc"
Te anexo el archivo para que verifiques el funcionamiento.
https://www.dropbox.com/s/mazgbhfjqrvixjw/demo%20con%20fecha%20de%20vigencia2.xlsm?dl=0
