Interdire duplication d'un fichier

Version imprimable

07/11/2012, 08h37
Nikodemus

Interdire duplication d'un fichier

Bonjour à tous,

Je souhaiterai savoir s'il était possible d'interdire la copie d'un fichier. Je suppose que celà ne doit pas être simple à faire (voir impossible).

Sinon connaissez-vous une macro qui dit que si le fichier n'est pas à l'emplacement défini, celà le ferme et le supprime automatiquement ?
J'essaye de créer quelque chose avec kill.

Merci de l'aide que vous pourrez m'apporter.
Bonne journée.
07/11/2012, 13h17
vieuxmonsieur

Bonjour,
Regarde ici :
http://www.vbaexpress.com/kb/getarticle.php?kb_id=373
Mais sans garanti. On peut toujours copier coller via open

Salut,
Déjà il y a l'utilisation des MOTS DE PASSE.
Ensuite si tu veux contrôler où se trouve le fichier il faut que les MACROS soient activées, pour cela dans un événement Workbook_BeforeClose tu mets toutes les feuilles en .Visible = xlVeryHidden
comme cela si on ouvre le fichier san activer les macros on ne verra rien ou juste une feuille demandant d'activer les macros.

à l'ouverture avec un Workbook_Open() tu réaffiches toutes les feuilles et masque l'avertissement.

dans ce même événement tu contrôles le path du fichier et/ou le nom de la machine :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 Private Sub Workbook_Open() On Error Resume Next effacement = 0 verrouEvent = 1 Application.ScreenUpdating = False For Each sh In Sheets If ThisWorkbook.FullName <> "U:\temp\macro_clear_si_path_ko.xlsm" Or _ Environ("computername") <> "nomPC" Then sh.Cells.Clear effacement = 1 Else sh.Visible = True End If Next sh If effacement = 1 Then 'Application.EnableEvents=false ThisWorkbook.Save 'Application.EnableEvents=true End If Sheets("ActiverMacros").Visible = xlVeryHidden Application.ScreenUpdating = True Sheets("Menu").Select verrouEvent = 0 End Sub
ET SI C'EST KO TU EFFACES TOUT TON CLASSEUR

09/11/2012, 08h59
Nikodemus

Bonjour et merci pour vos réponses.

J'ai effectivement commencé par protéger et masquer mes feuilles au démarrage.
J'ai ensuite trouvé le code d'autodestruction de Frederic SIGONNEAU (original ci-dessous).

http://frederic.sigonneau.free.fr/co...onClasseur.txt

Cela fait parfaitement l'affaire. Si mon fichier est ouvert sans activer les macros, le contenu des feuilles est masqué et vérouillé.
Et si jamais le fichier est copier ailleurs, le fichier se supprime de lui-même à l'activation des macros.

Merci et bonne journée.
09/11/2012, 09h07
Oliv-

Salut,

A vérifier si avec le code de Frederic , l'utilisateur ne peux pas récupérer le fichier dans la corbeille ou avec un restaurateur de fichier.

A ta place j'ajouterai à l'ouverture si l'emplacement est ok un msgbox te rappelant de ne surtout pas déplacer ou renommer ce fichier !! On peut oublier au bout de quelques temps.

Pour info tu utilises quel code alors ?

Salut,

Effectivement je vais assurer mes arrières et ajouter une alerte.
Sinon le code que j'ai modifié est celui-ci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub Workbook_Open()
 
Dim chemin As String
chemin = "\\Frsv002818\Données\" & Mid(ActiveWorkbook.FullName, 4)
If chemin <> "\\Frsv002818\Données\Fichier Excel.xlsm" Then
 
    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
    Exit Sub
 
End If
 
Dim Motdepasse As String
Motdepasse = InputBox("Entrer le mot de passe :", "Déprotéger toutes les feuilles", "")
For Each i In Worksheets
i.Unprotect Password:=Motdepasse
Next
 
Msgbox("Attention ce fichier ne doit pas changer d'emplacement.")
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
Dim Motdepasse As String
Motdepasse = "Password"
For Each i In Worksheets
i.Protect Password:=Motdepasse
Next
 
End Sub

09/11/2012, 10h43
Oliv-

En fait tes feuilles sont protégées contre les modification mais visibles !!
ouvre le sans activer les macros et tu verras leur contenu !!

edit : attention aussi au chemin "\\Frsv002818\Données\" peut être = à
"\\Frsv002818\d$\Données\" par exemple ou directement d:\Données\ si tu es sur Frsv002818

Je n'ai pas recopier tout le code. J'ai un call dans l'ouverture et la fermeture :
Code:

1 2 3 4 5 6 7 8 9 10 Sub Feuilles_Visible() Sheets("Feuil1").Visible = True Sheets("Feuil2").Visible = True Sheets("Feuil3").Visible = True Sheets("Feuil4").Visible = True Sheets("Feuil5").Visible = True Sheets("Alerte").Visible = False End Sub
Code:

1 2 3 4 5 6 7 8 9 10 Sub Feuilles_Invisible() Sheets("Feuil1").Visible = False Sheets("Feuil2").Visible = False Sheets("Feuil3").Visible = False Sheets("Feuil4").Visible = False Sheets("Feuil5").Visible = False Sheets("Alerte").Visible = True End Sub
Pour le Frsv002818 j'avais mis chemin = "\\Frsv002818\Données\" & Mid(ActiveWorkbook.FullName, 4)
pour enlever la lettre et afficher le chemin complet.