Microsoft 365 Classeur s'autodétruit si l'username de l'utilisateur n'est pas reconnu

[pat66]

Bonjour le forum,

est 'il possible qu'un classeur s'autodétruise si à l'ouverture de celui, l'username de l'utilisateur ne fait pas parti d'une liste saisie dans un champs de cellule

merci beaucoup pour votre aide

cdt

 

[sylvanu]

Bonjour Pat,
1- Le code "d'autodestruction" sera dans le fichier, donc difficile d'exécuter un code venant d'un fichier qui se détruit.
2- Il suffit à l'utilisateur d'interdire l'exécution de macros pour ouvrir le fichier en toute quiétude.

Ce qu'il est possible de faire au mieux est à l'enregistrement du fichier toutes les feuilles sont masquées. Ainsi à l'ouverture, si le pwd est mauvais on quitte XL. Avec un pwd sur le VBA bien sur.
Mais là encore, si l'utilisateur a de mauvaises intentions ( et un bon niveau en XL ), cela reste illusoire.
On peut cracker les mots de passe VBA. Tout dépend de la confiance que vous avez dans les utilisateurs potentiels.

L'autre solution, plus radicale, est de chiffrer votre fichier ( via Préparer/Chiffer le document )
Le fichier est chiffré et inaccessible.
Mais il n'y aura qu'un mot de passe unique pour l'ouvrir, et non une liste autorisée. A vous de donner le mot de passe à qui de droit.

 

[pat66]

Bonjour sylvanu,

merci pour vos conseils, en fait j'ai bien nommé un champs de cellules "habilitation" et saisis mon username "Utilisateur", mais le classeur s'ouvre quand même en lecture seule, je ne comprends pas pourquoi ?
est ce que le fait d'avoir changer de feuille le champs de cellules nommé peut avoir une influence ?

merci

Private Sub Workbook_Open()
  nom = Environ("username")
  Set temp = [habilitation].Find(what:=nom)
  If temp Is Nothing Then
  msgbox "coucou"
  ActiveWorkbook.ChangeFileAccess xlReadOnly
  End If
  End Sub

 

[sylvanu]

Re,
J'ai testé, c'est censé marcher.
Mais êtes vous sur d'avoir bien mis le username dans votre liste avec la bonne syntaxe ?
Rajoutez après nom=.... un "MsgBox nom" pour vérifier.

Private Sub Workbook_Open()
nom = Environ("username")
MsgBox nom
Set temp = [habilitation].Find(what:=nom)
If temp Is Nothing Then
MsgBox "coucou"
ActiveWorkbook.ChangeFileAccess xlReadOnly
End If
End Sub

 

[TooFatBoy]

Bonjour,

mais le classeur s'ouvre quand même en lecture seule, je ne comprends pas pourquoi ?

ben c est ce que tu lui demande de faire me semble 'til
un conseil corriges ton indentation tu vera peu être mieux la logique de ton code

 

[pat66]

Bonjour,
pas du tout, il ne doit se mettre en lecture seule que si l'username ne fait pas parti de la liste et ce n'est pas le cas ! puisque j'ai mis mon username dans la liste du champ "habilitation"

 

[TooFatBoy]

t es sur de saisir le bon mot
c est quoi tu appelle un champs de cellules

 

[pat66]

oui, j'ai fais comme m'a dit sylvanu pour bien vérifié mon username avec :

Private Sub Workbook_Open()
nom = Environ("username")
MsgBox nom
Set temp = [habilitation].Find(what:=nom)
If temp Is Nothing Then
MsgBox "coucou"
ActiveWorkbook.ChangeFileAccess xlReadOnly
End If
End Sub

ce problème est apparu dès que j'ai voulus déplacer le champs "habilitation" sur une autre feuille, bizarre !!

 

[TooFatBoy]

en supposant un champs soit une plage tu as plusieurs noms dans ton "champs"
ils sont triés

 

[sylvanu]

Re,
En désespoir de cause, essayez avec ça :

Private Sub Workbook_Open()
nom = Environ("username")
MsgBox nom
If Application.CountIf([habilitation], nom) = 0 Then
    MsgBox "coucou"
    ActiveWorkbook.ChangeFileAccess xlReadOnly
End If
End Sub

Sinon essayez de fournir un fichier représentatif et anonyme.

 

[patricktoulon]

Bonjour à tous
1°mettre le son
2°lancer le fichier
vous me pardonnerez mon coté blagueur

mais il est ou le fichier ..il est ou ??
LOL

 

[patricktoulon]

re
allez je vous donne le truc
changer "patricktoulon1 pour le nom que vous désirez

Private Sub Workbook_Open()
n = Environ("username")
If n <> "patricktoulon1" Then
Application.Speech.Speak " Bonjour " & n & "! votre mission que vous l'acceptez ou pas !et de regarder ce fichier s'auto détruire!" & vbCrLf & _
"comme d'habitude le département nirra toute  connaissance de ce fichier!" & vbCrLf & _
"ce message s'auto détruira dans deux secondes !! bONNE CHANCE"
autoDestruction
End If


End Sub
Sub autoDestruction()
    Dim x&, codevbs$, vbsfile$
    vbsfile = ThisWorkbook.Path & "\destructeur.vbs"
    codevbs = "wscript.sleep 200" & vbCrLf & "fself = WScript.ScriptFullName" & vbCrLf
    codevbs = codevbs & "fichier = """ & ThisWorkbook.FullName & Chr(34) & vbCrLf
    codevbs = codevbs & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    codevbs = codevbs & "If objFSO.FileExists(fichier) Then objFSO.deletefile fichier" & vbCrLf
    codevbs = codevbs & "objFSO.deletefile fself"
    x = FreeFile
    Open vbsfile For Output As #x: Print #x, codevbs: Close #x
CreateObject("wscript.shell").Run vbsfile
ActiveWindow.Close , False
End Sub

 

[pat66]

en supposant un champs soit une plage tu as plusieurs noms dans ton "champs"
ils sont triés

re,

oui il y a plusieurs noms et ne sont pas triés par ordre alphabétique

 

[pat66]

re
allez je vous donne le truc
changer "patricktoulon1 pour le nom que vous désirez

Private Sub Workbook_Open()
n = Environ("username")
If n <> "patricktoulon1" Then
Application.Speech.Speak " Bonjour " & n & "! votre mission que vous l'acceptez ou pas !et de regarder ce fichier s'auto détruire!" & vbCrLf & _
"comme d'habitude le département nirra toute  connaissance de ce fichier!" & vbCrLf & _
"ce message s'auto détruira dans deux secondes !! bONNE CHANCE"
autoDestruction
End If


End Sub
Sub autoDestruction()
    Dim x&, codevbs$, vbsfile$
    vbsfile = ThisWorkbook.Path & "\destructeur.vbs"
    codevbs = "wscript.sleep 200" & vbCrLf & "fself = WScript.ScriptFullName" & vbCrLf
    codevbs = codevbs & "fichier = """ & ThisWorkbook.FullName & Chr(34) & vbCrLf
    codevbs = codevbs & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    codevbs = codevbs & "If objFSO.FileExists(fichier) Then objFSO.deletefile fichier" & vbCrLf
    codevbs = codevbs & "objFSO.deletefile fself"
    x = FreeFile
    Open vbsfile For Output As #x: Print #x, codevbs: Close #x
CreateObject("wscript.shell").Run vbsfile
ActiveWindow.Close , False
End Sub

Excellent mais j'ai un bug à la fin avec : CreateObject("wscript.shell").Run vbsfile et ensuite je dois pouvoir avoir vérifier plusieurs username

 

[pat66]

Re,
En désespoir de cause, essayez avec ça :

Private Sub Workbook_Open()
nom = Environ("username")
MsgBox nom
If Application.CountIf([habilitation], nom) = 0 Then
    MsgBox "coucou"
    ActiveWorkbook.ChangeFileAccess xlReadOnly
End If
End Sub

Sinon essayez de fournir un fichier représentatif et anonyme.

re,

demain ,je teste cette solution

merci