XL 2010 auto destruction d'un fichier a une date précise pour un fichier .xltm

[sebbbbb]

Bonjour

je souhaiterai qu'un code d'auto destruction d'un fichier se lance à l'ouverture pour un fichier a une date bien précise (pour éviter que le fichier soit utilisé à l'extérieur de l'entreprise par ancien stagiaire ou ancien collègues).

j'ai bien trouvé le code ci-dessous :

mais lors de l'enregistrement j'ai toujours un message d'erreur qui s'affiche à l'ouverture (voir ci-dessous)

merci a vous par avance

seb

 

[sebbbbb]

Oui j avais pris soin de modifier la date

Tu indiques ajouter du code a sub autodestroy mais lequel ? Celui que j ai induque dans post 1 ?

 

[soan]

J'ai vu le post #1 ; nouvelle version :

Option Explicit

Private Sub AutoDestroy()
  Application.DisplayAlerts = False
  'ici, ce que tu veux faire : par exemple simplement fermer le fichier ;
  'ou pire : par exemple autodestruction du fichier Excel .xlsm.
  ThisWorkbook.Close savechanges:=False
  Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
  Dim DateExpiration As Date: Application.ScreenUpdating = False
 
  DateExpiration = DateSerial(2020, 9, 20) 'expiration au 20 Septembre 2020
  If Date >= DateExpiration Then AutoDestroy
 
  'suite du code habituel de la sub Workbook_Open(), s'il y en a un,
  'car c'est pas obligatoire : c'est selon ce que tu veux faire !
 
  'inutile de mettre Application.ScreenUpdating = True car
  'c'est fait automatiquement juste avant sortie de la sub
End Sub

soan

 

[sebbbbb]

Merci Soan

le Hic c'est que j'ai un userform avant le fermeture du fichier qui contrarie le script

tu me diras j'ai qu'à l'enlever mais c'est pas aussi simple ; y a t il un moyen de zpper également ce script seulement au cas ou la date fatidique est passée ?

ci-dessous mon message . evidemment si l'utilisateur clique sur non celà ouvre le fichier normaleme,nt

 

[soan]

Pour la 2ème ligne de ton UserForm, il manque un mot ; ça doit être :

« SVP, MERCI DE CONFIRMER QUE VOUS AVEZ : »

-------------------------------------------------------------------------------------------------

Tu as écrit : « j'ai un UserForm avant la fermeture du fichier »

Or comme ce UserForm n'est pas lancé dès l'ouverture du fichier, il y a bien un moment,
avant la fermeture du classeur, où tu demandes l'affichage de ce UF ; par exemple :

UserForm1.Show

Aussi, tu peux ajouter une condition au lancement, la condition inverse
de celle qui lance la sub AutoDestroy() :

If Date < DateExpiration Then UserForm1.Show

Ainsi, le UF sera affiché seulement si la Date d'Expiration n'est pas atteinte ;
mais d'un autre côté, si la Date d'Expiration est atteinte ou dépassée, ça
ne devrait même pas arriver au stade de UserForm1.Show puisque dans
ce cas, la sub AutoDestroy() est appelée, qui ferme le fichier sans aucun
avertissement, et sans sauvegarde des changements.

soan

 

[sebbbbb]

Desole je me suis mal exprime ce n est pas un userform mais msgbox qui est lance par un autre code vba a l enregistrement du fichier

 

[soan]

ben dans ce cas, même traitement : If Date < DateExpiration Then MsgBox "..."

... et même remarque à propos du stade d'exécution : ça ne devrait même pas
arriver jusqu'ici vu que la sub AutoDestroy() se déclenche, et ferme le fichier
(cela dans le cas où la Date d'Expiration est atteinte ou dépassée).

soan

 

[patricktoulon]

bonsoir
si je ne me trompe pas on parle d'un xltm(fichier modele) et a la base on ne peut les modifier sauf si ouvert en mode modifiable
il faut donc quand tu es sur la copie xlsm l'ouvrir modifiable et là tu peux faire ce que tu veux
dessus
'l'argument "Modifiable" (Editable) doit être à vrai pour ouvrir l'original
Set Classeurxltm = Workbooks.Open(Chemin & fichierxltm, , , , , , , , , True)

 

[sebbbbb]

Merci mais en fait c est l original que je veux modifier (fichier modele)

 

[patricktoulon]

Merci mais en fait c est l original que je veux modifier (fichier modele)

mon francais serait il incorrect??

 

[soan]

@patricktoulon

euh... oui, désolé : c'est « français », pas « francais » !

tu peux aussi ajouter un trait d'union : « serait-il »

soan

 

[ToF62]

Bonjour,

Par sécurité moi je rajouterai que si tu ouvre ton programme avec ton username alors pas besoin de supprimer ton fichier.

Private Sub Workbook_Open()
If environ(USERNAME) = "ton username" Then
Else
Application.ScreenUpdating = False
DateExpiration = DateSerial(2022, 1, 1)
If DateExpiration <= Date Then
Dim NomComplet As String
NomComplet = Application.ActiveWorkbook.FullName
ActiveWorkbook.Saved = True
Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill NomComplet
Application.ActiveWorkbook.Close False
Else
End If
Application.ScreenUpdating = True
End If
End Sub

ToF

 

[sebbbbb]

Merci tof
MAis j aimerai que le programme a une date fixe a l avance

 

[ToF62]

Merci tof
MAis j aimerai que le programme a une date fixe a l avance

DateExpiration = DateSerial(2022, 1, 1)
Donc expire le 01 Janvier 2022, sauf erreur de ma part est une date fixe, sa sera pas ni avant ni après.

a moins que je n'ai pas compris ta demande.

ToF

 

[fanch55]

Bonsoir à tous,
Bizarre, c'est une demande récurrente !!

XL 2013 - Fichier Excel qui s'autodetruit

Bonjour a la communauté, Je souhaite avoir un code qui au moment de l'ouverture d'un fichier excel, le code vérifie l'emplacement de ce dernier et s'il n'est pas dans un répertoire précis, alors il se détruit/supprime. Je suis embêté car j'ai trouvé un code qui fonctionne sur du .xls mais pas...

www.excel-downloads.com

 

[Victor21]

Bonsoir, fanch55

Bonsoir à tous,
Bizarre, c'est une demande récurrente !!

XL 2013 - Fichier Excel qui s'autodetruit

Bonjour a la communauté, Je souhaite avoir un code qui au moment de l'ouverture d'un fichier excel, le code vérifie l'emplacement de ce dernier et s'il n'est pas dans un répertoire précis, alors il se détruit/supprime. Je suis embêté car j'ai trouvé un code qui fonctionne sur du .xls mais pas...

www.excel-downloads.com

S l'on devait ignorer les demandes récurrentes, il n'y aurait -presque- plus de XLD.