Durée d'utilisation limité mais sous condition

[Ilino]

Forum Bonjour;

Je souhaite créer une Macro qui limite la durée d'utilisation du fichier
Exemple une fois la date limite est aboutée (cellule A1) ,je souhaite masquer le fichier(original) complètement dans un répertoire bien définit ( dans Windows) avec un MDP et afficher a l’utilisateur un fichier copie mais sans macro ,mais l’original est caché dans le Répertoire Windows
GRAZIE

 

[job75]

Re : Durée d'utilisation limité mais sous condition

Re,

Ah oui tu veux aussi mettre un mot de passe sur le fichier original :

Private Sub Workbook_Open()
Dim feuille$, f$, fn$, wb As Workbook
feuille = Feuil1.Name 'Feuil1 est le CodeName
If Date >= Sheets(feuille).[A1] Then
  f = Me.Name
  fn = Me.FullName
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.EnableEvents = False
  On Error Resume Next
  Me.SaveAs Left(fn, Len(fn) - 5), 51 'fichier .xlsx
  Set wb = Workbooks.Open(fn) 'rouvre le fichier .xlsm
  wb.Sheets(feuille).[A1] = 3000000
  wb.SaveAs fn, Password:="mdp" 'mot de passe à adapter
  Application.OnTime 1, "'" & f & "'!ThisWorkbook.Rouvre"
  Application.EnableEvents = True
  Me.Close False 'ferme le fichier .xlsx
End If
End Sub

Sub Rouvre()
Dim fn$
fn = Me.FullName
Workbooks.Open Left(fn, Len(fn) - 5) & ".xlsx"
Me.Close False
End Sub

A+

 

[chris]

Re : Durée d'utilisation limité mais sous condition

Bonjour

Est-on sûr qu'Excel a le droit d'écrire dans C:\Windows si l'utilisateur n'est pas admin de son poste ?

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Bonjour Tous le monde , VICTOR; MAITRE;CHRIS,
@ chris : sinon un fichier predefinit
@ Job: grazie pour le code , je vais le tester
A+

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Bonjour Tous le monde , VICTOR; MAITRE;CHRIS,
@ chris : sinon un fichier predefinit
@ Job: grazie pour le code , je vais le tester
A+

 

[job75]

Re : Durée d'utilisation limité mais sous condition

Re, salut chris,

Comme je l'ai dit je ne vois pas l'intérêt de créer un fichier .xlsx.

Ceci devrait suffire :

Private Sub Workbook_Open()
If Date >= Feuil1.[A1] Then
  Dim fn$
  Feuil1.[A1] = 3000000
  fn = Me.FullName
  Application.DisplayAlerts = False
  Me.SaveAs fn, Password:="mdp" 'mot de passe à adapter
  Workbooks.Open fn 'rouvre le fichier
End If
End Sub

En plus cela fonctionne sur les versions antérieures à Excel 2007, ce qui n'était pas le cas précédemment.

A+

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Re
désole pour le double de message ???
le code de JOB fonctionne parfaitement mais je souhaite sauvegarder une copie orignale ( avec les macro) dans un répertoire bien definit sans informer l'utilisateur
A+

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Re Job
pourquoi dans le code de post# 20 si Date est sup A1 il m'affiche deux fois la fenetre de Mot de Passe ?
2. le code VBA existe toujour dans le fichier ??
A+

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Forum Bonjour
donc il n y a pas une possibilité de sauvegarder l'original dans un repertoire bien definié ??
A+

 

[MJ13]

Re : Durée d'utilisation limité mais sous condition

Bonjour à tous

donc il n y a pas une possibilité de sauvegarder l'original dans un repertoire bien definié ??

Tu peux faire une copie du fichier vers un dossier avec SaveCopyAs .

 

[job75]

Re : Durée d'utilisation limité mais sous condition

Re,

je souhaite sauvegarder une copie orignale ( avec les macro) dans un répertoire bien definit sans informer l'utilisateur

Alors crée un dossier "Dossier secret", utilisé dans la macro Rouvre :

Private Sub Workbook_Open()
Dim feuille$, f$, fn$, wb As Workbook
feuille = Feuil1.Name 'Feuil1 est le CodeName
If Date >= Sheets(feuille).[A1] Then
  f = Me.Name
  fn = Me.FullName
  Application.DisplayAlerts = False
  Application.EnableEvents = False
  On Error Resume Next
  Me.SaveAs Left(fn, Len(fn) - 5), 51 'fichier .xlsx
  Set wb = Workbooks.Open(fn) 'rouvre le fichier .xlsm
  wb.Sheets(feuille).[A1] = 3000000
  wb.Save 'enregistrement normal
  Application.OnTime 1, "'" & f & "'!ThisWorkbook.Rouvre"
  Application.EnableEvents = True
  Me.Close False 'ferme le fichier .xlsx
End If
End Sub

Sub Rouvre()
Dim chemin$, fn$
chemin = "C:\Dossier secret\" 'à adapter
fn = Me.FullName
Application.DisplayAlerts = False
On Error Resume Next 'sécurité
Workbooks.Open Left(fn, Len(fn) - 5) & ".xlsx"
Me.SaveAs chemin & Me.Name, Password:="mdp" 'mot de passe à adapter
Kill fn 'supprime le fichier.xlsm du répertoire courant
Me.Close False
End Sub

A+

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Bonjour MICHEL
c'est une idé
A+

 

[job75]

Re : Durée d'utilisation limité mais sous condition

pourquoi dans le code de post# 20 si Date est sup A1 il m'affiche deux fois la fenetre de Mot de Passe ?

Parce que tu as très mal testé

Le code du post #20 est vraiment simplissimo, tu devrais arriver à le comprendre !

A+

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Re
grazie MASTER, ora è funzionale.
A+

 

[Ilino]

Re : Durée d'utilisation limité mais sous condition

Re,
Sorry MAITRE si je reopen le fichier orignal (cacher) il m’affiche une Erreur d’exécution 6 : Dépassement de capacité
??
GRAZIE

 

[job75]

Re : Durée d'utilisation limité mais sous condition

Re,

Une solution nettement plus simple avec une seule macro :

Private Sub Workbook_Open()
Dim c As Range, chemin$, fn$
Set c = Feuil1.[A1] 'CodeName à adapter
If Date >= c Then
  chemin = "C:\Dossier secret\" 'à adapter
  fn = Me.FullName
  Application.DisplayAlerts = False
  On Error Resume Next
  c = 3000000
  Me.SaveAs chemin & Me.Name, Password:="mdp" 'mot de passe à adapter
  Kill fn 'supprime le fichier du dossier courant
  Me.SaveAs Left(fn, Len(fn) - 5), 51, Password:="" 'fichier .xlsx
  Workbooks.Open Left(fn, Len(fn) - 5) & ".xlsx" 'rouvre le fichier
End If
End Sub

A+