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 du .xlsm:
Dans Thisworkbook:
Private Sub Workbook_Open()
If ThisWorkbook.Path <> "C:\Users\transfert" Then
Call Suicide2
End If
End Sub
Dans un module :
Option Explicit
Sub Suicide2()
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub
Ca fonctionne affreusement bien sur du 2003 mais il n'apprécie pas le " Kill .FullName". Mais je voudrais que cela fonctionne sur du Excel 2010 .
Je ne comprends pas, le code du post #1 fonctionne sur les fichiers .xlsm, en tout cas chez moi sur Excel 2013.
Mais ce code dans Thisworkbook est bien plus simple et plus complet :
Code:
Private Sub Workbook_Open()
If Me.Path <> "C:\Users\transfert" Then
Me.ChangeFileAccess xlReadOnly
Kill Me.FullName
Me.Saved = True
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End If
End Sub
Il y a quelques temps, j'ai beaucoup cherché ce genre de code.
Je ne sais plus où je l'ai obtenu mais j'ai ce code qui autodétruit le fichier ouvert à la date de votre choix, quel que soit son nom, sa version et son emplacement.
Dans le Thisworkbook
Code:
Private Sub Workbook_Open()
If CLng(Date) > 43000 Then '43000 =nbr 22/09/2017 autodestruction
MsgBox ("Cliquez pour continuer")
Call Suicide2
End If
end sub
dans un module
Code:
Sub Suicide2()
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub
On peut simplifier comme ceci :
Uniquement dans le Thisworkbook
Code:
Private Sub Workbook_Open()
If CLng(Date) > 43000 Then '43000 =nbr 22/09/2017 autodestruction
MsgBox ("Cliquez pour continuer")
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End If
End Sub
ça fonctionne super bien
Bonne journée à toutes et à tous,
Amicalement,
Lionel,
Pourquoi créer un classeur pour le détruire ensuite?
C'est de la maltraitance caractérisée envers les Cellules Sacrées du Grand Tableur
Sinon il suffit d'ouvrir le classeur sans activer les macros pour enrayer la destruction du dit classeur (mais cela tu le sais déjà arthour973, on a eu l'occasion d'en débattre au fil d'une de tes discussions sur XLD)
Donc en fait tu ne voudrais laisser la possibilité que de sauvegarder le fichier à son emplacement et avec un nom particulier ? ça je en sais pas si c'est possible et j'allais te proposer la même solution le module "suicide"
dans thisworkbook :
VB:
Private Sub Workbook_Open()
If Date > DateSerial(2017, 12, 1) Then
Suicide
Else
MsgBox "Have a nice day !"
End If
End Sub
et dans un module :
VB:
Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .Name Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub
Je penses comprendre le soucis: tous vos codes fonctionnent mais je test sur "Mon bureau" de mon entreprise.
Or, nous avons OneDrive de déployé. Je pense que OneDrive bloque la suppression et que du fait, je ne pourrais jamais le supprimer n'ayant pas les "droits".