Mensaje de alerta
Hola Valedor, la otroa vez te pregunte sobre el tema, pero no fui muy claro, por lo que recurro nuevamente a tu ayuda, He desarrollado un pequeño sistema contable en Excel, el cual es operativo por por días, luego del cual deseo que verifique la fecha si es diferente cierra la planilla con un password desconocido, para el usuario
La planilla la primera vez y hasta la fecha indicada no tiene password
Este seria el código, que haría algo como auto guardar
Option Explicit
Public WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal ubica As Excel.Workbook)
On Error Resume Next
Dim nombre As String
nombre = ActiveWorkbook.Name
Dim mifecha As Date
mifecha = ActiveSheet.Range("a1")
If ActiveSheet.mifecha.Value => "31/12/99" Then
ActiveWorkbook.SaveAs FileName:=nombre, FileFormat:=xlNormal, _
Password:="nunca", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ThisWorkbook.Close False
Else
End If
End Sub
Lo que deseo es que cuando llegue el momento de que se active el macro de "cancelación de licencia", este no pregunte al usuario si desea grabar, sino que coloque el password y luego grabe, de manera a que la siguiente vez ya no se pueda abrir sin el password.
La planilla la primera vez y hasta la fecha indicada no tiene password
Este seria el código, que haría algo como auto guardar
Option Explicit
Public WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal ubica As Excel.Workbook)
On Error Resume Next
Dim nombre As String
nombre = ActiveWorkbook.Name
Dim mifecha As Date
mifecha = ActiveSheet.Range("a1")
If ActiveSheet.mifecha.Value => "31/12/99" Then
ActiveWorkbook.SaveAs FileName:=nombre, FileFormat:=xlNormal, _
Password:="nunca", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ThisWorkbook.Close False
Else
End If
End Sub
Lo que deseo es que cuando llegue el momento de que se active el macro de "cancelación de licencia", este no pregunte al usuario si desea grabar, sino que coloque el password y luego grabe, de manera a que la siguiente vez ya no se pueda abrir sin el password.
1 Respuesta
Respuesta de valedor
1
'Yo utilizo esta tecnica
Option Explicit
Private Sub Workbook_Open()
Dim datPrimerDia As Date
Dim strEjecutado As String
Dim strCaducado As String
Dim intDias As Integer
'Los metodos GetSetting y SaveSetting son una función y un metodo
'respectivamente que nos permiten recuperar y guardar, respectivamente
'diversos claves y valores, estan se guardan en el registro de Windows
'especificamente en
' HKEY_CURRENT_USER\Software\VB and VBA Program Settings
'lo cual nos permite almacenar todos los valores que quieramos
'Recupero una cadena con la cual se si el libro ya fue abierto
strEjecutado = GetSetting("Proyecto", "Validar", "Ejecutado", "")
'Si strEjecutado = "SI" quiere decir que ya ha sido abierto el libro
If strEjecutado = "SI" Then
'Recupero el dia en que fue abierto por primera vez
datPrimerDia = GetSetting("Proyecto", "Validar", "PrimerDia")
'Obtengo el número de dias transcurridos
intDias = Date - datPrimerDia
'Si son mas de treinta, claro, pueden ser los que tu quieras
If intDias > 30 Then
'Obtengo una cadena que me dice si ya esta caducado
strCaducado = GetSetting("Proyecto", "Validar", "Caducado", "")
'Si no esta caducado
If strCaducado = "" Then
'Guardo una clave indicando que el libro ya esta caducado
SaveSetting "Proyecto", "Validar", "Caducado", "SI"
'Desactivo que se muestren los mensajes de alerta
'esto es para que no le pregunte al usuario si quiere
'sobreescribir el libro, puesto que será guardado con el mismo nombre
Application.DisplayAlerts = False
'Guardo el libro con el mismo nombre y el mismo lugar
'con la clave de apertura y escritura, en este caso la clave es
' ábrete
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, , "abrete", "abrete"
'Activo que se muestre los mensajes en pantalla
Application.DisplayAlerts = True
End If
End If
Else
'Si es la primera vez que lo abre, guarda esta informacion
'asi como el dia actual
SaveSetting "Proyecto", "Validar", "Ejecutado", "SI"
SaveSetting "Proyecto", "Validar", "PrimerDia", Date
End If
End Sub
'Esta macro es solo de ayuda en las pruebas, borra todas las claves de
'la seccion Validar y duarda el libro, quitandole las contraseñas
Public Sub BorrarClaves()
DeleteSetting "Proyecto", "Validar"
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, , "", ""
End Sub
Option Explicit
Private Sub Workbook_Open()
Dim datPrimerDia As Date
Dim strEjecutado As String
Dim strCaducado As String
Dim intDias As Integer
'Los metodos GetSetting y SaveSetting son una función y un metodo
'respectivamente que nos permiten recuperar y guardar, respectivamente
'diversos claves y valores, estan se guardan en el registro de Windows
'especificamente en
' HKEY_CURRENT_USER\Software\VB and VBA Program Settings
'lo cual nos permite almacenar todos los valores que quieramos
'Recupero una cadena con la cual se si el libro ya fue abierto
strEjecutado = GetSetting("Proyecto", "Validar", "Ejecutado", "")
'Si strEjecutado = "SI" quiere decir que ya ha sido abierto el libro
If strEjecutado = "SI" Then
'Recupero el dia en que fue abierto por primera vez
datPrimerDia = GetSetting("Proyecto", "Validar", "PrimerDia")
'Obtengo el número de dias transcurridos
intDias = Date - datPrimerDia
'Si son mas de treinta, claro, pueden ser los que tu quieras
If intDias > 30 Then
'Obtengo una cadena que me dice si ya esta caducado
strCaducado = GetSetting("Proyecto", "Validar", "Caducado", "")
'Si no esta caducado
If strCaducado = "" Then
'Guardo una clave indicando que el libro ya esta caducado
SaveSetting "Proyecto", "Validar", "Caducado", "SI"
'Desactivo que se muestren los mensajes de alerta
'esto es para que no le pregunte al usuario si quiere
'sobreescribir el libro, puesto que será guardado con el mismo nombre
Application.DisplayAlerts = False
'Guardo el libro con el mismo nombre y el mismo lugar
'con la clave de apertura y escritura, en este caso la clave es
' ábrete
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, , "abrete", "abrete"
'Activo que se muestre los mensajes en pantalla
Application.DisplayAlerts = True
End If
End If
Else
'Si es la primera vez que lo abre, guarda esta informacion
'asi como el dia actual
SaveSetting "Proyecto", "Validar", "Ejecutado", "SI"
SaveSetting "Proyecto", "Validar", "PrimerDia", Date
End If
End Sub
'Esta macro es solo de ayuda en las pruebas, borra todas las claves de
'la seccion Validar y duarda el libro, quitandole las contraseñas
Public Sub BorrarClaves()
DeleteSetting "Proyecto", "Validar"
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, , "", ""
End Sub
