Comment faire pour qu'un classeur se détruise à une date prévue ?
Ci-dessous une sub de Chip Pearson qui le fait (attention
elle marche vraiment !) il ne te reste plus qu'à la lancer
le jour désiré ...
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 = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub
elle marche vraiment !) il ne te reste plus qu'à la lancer
le jour désiré ...
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 = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub
Bob Umlas, Chip Pearson, (N°691)
Peut-on supprimer un fichier avec VBA ?
Kill étant efficace mais radical, une autre solution pour changer un peu :
envoyer le fichier dans la corbeille
'============dans un module standard
Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Sub test()
RecycleFile "D:06OfficeVBAClasseur1.xls"
End Sub
Sub RecycleFile(sFile As String)
'Chip Pearson, mpep
Const FO_DELETE = &H3
Const FOF_ALLOWUNDO = &H40
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
Dim sFileName As String
With FileOperation
.wFunc = FO_DELETE
.pFrom = sFile
.fFlags = FOF_ALLOWUNDO
End With
lReturn = SHFileOperation(FileOperation)
End Sub
envoyer le fichier dans la corbeille
'============dans un module standard
Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Sub test()
RecycleFile "D:06OfficeVBAClasseur1.xls"
End Sub
Sub RecycleFile(sFile As String)
'Chip Pearson, mpep
Const FO_DELETE = &H3
Const FOF_ALLOWUNDO = &H40
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
Dim sFileName As String
With FileOperation
.wFunc = FO_DELETE
.pFrom = sFile
.fFlags = FOF_ALLOWUNDO
End With
lReturn = SHFileOperation(FileOperation)
End Sub
Frédéric Sigonneau, Chip pearson, (N°690)
Comment détruire un fichier
Kill "Q:DATAMAGAS_BTFINANCESWeekly adminweekly.xls"
Attention c'est irrémédiable !
Attention c'est irrémédiable !
ChrisV, (N°689)
Comment faire pour qu'un classeur se bloque après trois mois pour obliger l'utilisateur à
utiliser une version à jour ?
Public ddd as date, jr as byte
Private Sub Workbook_Open()
Dim jr$,,jj$, i%, ddd as date
' jr$ = 2 utilisations:1/suite de caractères écrits,
' 2/définir le singulier ou le pluriel du mot jour dans le
' texte du MsgBox. jj$=suite de caractères lus
Windows("zaza.xls").Activate ' Remplacer zaza par le nom de votre application
Sheets("Feuil1").Activate
If [cellule] = "Mot clé" Then ' Mot clé est le mot clé connu de vous seul
' qui sera changé en une série de caractères correspondants à la date d'ouverture
'de l'application, définis par la routine suivante:
For i = 1 To Len(Str(Date))
jr$ = jr$ & Chr(nombre + (i * -2) + Asc(Mid(Str(Date), i))) 'nombre est un
' nombre qui ne doit pas être inférieur à 30 ou supérieur à 255
Next i
[cellule] = jr$
End If
' Vient ensuite la routine qui procède à la lecture du mot et le transforme en date
For i = 1 To Len(Sheets("Feuil1").[cellule])
jj$ = jj$ & Chr(Asc(Mid(Sheets("feuil1").[cellule], i)) - (55 + (i * -2)))
Next i
ddd = jj$
If 60 - (Date - ddd)> 1 Then jr$ = " jours" Else jr$ = " jour"
MsgBox " Plus que " & 60 - (Date - ddd) & jr$ & " d 'essai "
Remplacer le mot cellule par l'adresse d'une cellule de Feuil1, au choix et notez la.
Avant d'enregistrer votre classeur inscrivez votre mot clé dans la cellule choisie.
Private Sub Workbook_Open()
Dim jr$,,jj$, i%, ddd as date
' jr$ = 2 utilisations:1/suite de caractères écrits,
' 2/définir le singulier ou le pluriel du mot jour dans le
' texte du MsgBox. jj$=suite de caractères lus
Windows("zaza.xls").Activate ' Remplacer zaza par le nom de votre application
Sheets("Feuil1").Activate
If [cellule] = "Mot clé" Then ' Mot clé est le mot clé connu de vous seul
' qui sera changé en une série de caractères correspondants à la date d'ouverture
'de l'application, définis par la routine suivante:
For i = 1 To Len(Str(Date))
jr$ = jr$ & Chr(nombre + (i * -2) + Asc(Mid(Str(Date), i))) 'nombre est un
' nombre qui ne doit pas être inférieur à 30 ou supérieur à 255
Next i
[cellule] = jr$
End If
' Vient ensuite la routine qui procède à la lecture du mot et le transforme en date
For i = 1 To Len(Sheets("Feuil1").[cellule])
jj$ = jj$ & Chr(Asc(Mid(Sheets("feuil1").[cellule], i)) - (55 + (i * -2)))
Next i
ddd = jj$
If 60 - (Date - ddd)> 1 Then jr$ = " jours" Else jr$ = " jour"
MsgBox " Plus que " & 60 - (Date - ddd) & jr$ & " d 'essai "
Remplacer le mot cellule par l'adresse d'une cellule de Feuil1, au choix et notez la.
Avant d'enregistrer votre classeur inscrivez votre mot clé dans la cellule choisie.
Frédo P, (N°688)