Date limite d'utilisation pour un fichier Excel

Bonjour à tous,

Je suis actuellement à la recherche d'un moyen de protéger un fichier EXCEL en y intégrant une date limite d'utilisation.

Autrement dit, je choisi une date précise et au-delà de cette date deux possibilités :

• Soit le fichier ne peut plus être ouvert ;
• Soit il devient inutilisable.

Je suis ouvert à toute proposition ou bricolage.

Merci d'avance...

Bonsoir

En macro (mais ne fonction que si les macros sont fonctionnelles) :

Dans workbook open

Private Sub Workbook_Open()

If DateDiff(d, Now, "15/01/2015") <= 0 Then ' si ladifférence est égale à 0 ou inférieur alors
Application.DisplayAlerts = False ' on supprime les messages d'alertes
ActiveWorkbook.Saved = True ' on simule que le fichier est sauvegardé deuxième protection par rapport au messages d'alertes
ActiveWorkbook.Close ' on ferme
End If

End Sub

A essayer sans tarder !!!!

@ bientôt

LouReeD

Bonjour Loureed, Grinch,

et autre option.... A l'ouverture du fichier destruction définitive de celui-ci (avec message d'alerte) si la date d'utilisation arrive à échéance. Je ne sais plus où j'ai trouvé ce code mais il fonctionne bien.

1) Insérer dans ThisWorkBook le code suivant :

(Dans le code suivant la date est programmée au 15.02.2015)

Private Sub Workbook_Open()
'Determinez la date limite dans le format mois / jour / année
If Now() > #2/15/2015# Then
    MsgBox "Attention la date d'expiration est arrivée." & " Ce fichier sera détruit dans  5 secondes. Merci."
    Sleep 3000 'Sleep calcule en millisecondes. Donc Sleep 1000 attendra 1 seconde...
    Call DESTRUCTION_FICHIER
Else
MsgBox "Attention le fichier est utilisable jusqu'au 15 février 2015."
End If
End Sub

2) Inséser dans un module le code suivant :

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Attention ça marche vraiment ! la macro fonctionnera en fonction du jour déterminé
Sub DESTRUCTION_FICHIER()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
    .Save
    For Ndx = 1 To Application.RecentFiles.Count
        If Application.RecentFiles(Ndx).Path = .FullName Then
            Application.RecentFiles(Ndx).Delete
            Exit For
        End If
    Next Ndx
    .ChangeFileAccess Mode:=xlReadOnly
    Kill .FullName
    .Close SaveChanges:=False
End With
End Sub