auto suppression

GS82

XLDnaute Occasionnel
salut à tous
y'a il un code ou un astuce pour qu'un fichier excel s'auto detruit après une période (comme les applications qui ne sont utilisables que pendant une periode d'essai puis ça marche plus)...
j'en serais reconnaissant
a+
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : auto suppression

Bonjour,

Code:
Private Sub Workbook_Open()
  If Sheets("secret").[A1] = "" Then
    Sheets("secret").[A1] = Date + 30
    MsgBox "Valable jusqu'au " & Sheets("secret").[A1]
    Sheets("secret").visible = xlVeryHidden
    ActiveWorkbook.Save
  Else
    If Date > Sheets("secret").[A1] Then
       MsgBox "expiré"
       ActiveWorkbook.ChangeFileAccess xlReadOnly
       Kill ActiveWorkbook.FullName
       ActiveWorkbook.Close False
    End If
  End If
End Sub


JB
Formation Excel VBA JB
 

Pièces jointes

  • Protection30joursAutoDestruction.xls
    41.5 KB · Affichages: 386

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : auto suppression

Re Bonjour Staple1600,

-On peut masquer toutes les feuilles à la sauvegarde et les démasquer à l'ouverture.Si on désactive VBA, l'appli est inutilisable.

-Le projet étant protégé, on ne peut pas supprimer le VBA

Code:
Private Sub Workbook_Open()
  If Sheets("secret").[A1] = "" Then
    Sheets("secret").[A1] = Date + 30
    MsgBox "Valable jusqu'au " & Sheets("secret").[A1]
    Sheets("secret").visible = xlVeryHidden
    ActiveWorkbook.Save
  Else
    If Date > Sheets("secret").[A1] Then
       Sheets("utilisateur").visible = xlVeryHidden
       MsgBox "expiré"
       ActiveWorkbook.Save
       ActiveWorkbook.Close
    End If
  End If
End Sub

JB
 

GS82

XLDnaute Occasionnel
Re : auto suppression

re salut
en fait y'aun petit truc qui me gene
dans le fichier test le code marche
mais quand j'integre ça dans mon petit GPAO
il me signale QUE DATE EST UN OBJET introuvable
voici le code que j'ai utilisé

Sub finish()
Dim FIN_PERIODE_ESSAI As Date
FIN_PERIODE_ESSAI = DateSerial(2008, 8, 4)
If Date > FIN_PERIODE_ESSAI Then
MsgBox ("Période d'essai terminée")

With ThisWorkbook
Application.DisplayAlerts = False
If .Path <> vbNullString Then
.ChangeFileAccess xlReadOnly
kill .FullName
End If
ThisWorkbook.Close SaveChanges:=False
End With

End If
End Sub

j'èspère que je vous gene pas chui encore debutant en VBA !!
merci
 

Discussions similaires

Réponses
1
Affichages
311

Statistiques des forums

Discussions
311 725
Messages
2 081 944
Membres
101 849
dernier inscrit
florentMIG