Empecher la copie d'un fichier

[BLACKHAYES]

bonjour le forum,

je voudrais savoir si il est possible d'empecher la copie d'un fichier excel sans pour autant interdure l'ouverture et l'acces aux feuilles;

BLAKHAYE's

 

[patricktoulon]

pour ouvrir le fichier de job ouvre ton application en bloquant vba

 

[patricktoulon]

mot de passe input= "taratata" mot de passe vbproject ="toto"

 

[Arone]

Bonjour Arone, JPSonic51, patricktoulon, le fil,

Ce n'est pas très compliqué, pour tester téléchargez le fichier joint, il contient la macro Workbook_Open.

Faites un copier-coller du fichier et donnez-lui le nom que vous voulez, par exemple Classeur version(2).

Ouvrez ce nouveau fichier sans activer les macros.

Allez dans Thisworkbook et désactivez la macro avec Workbook_Open: End

Enregistrez le fichier, fermez-le et ouvrez-le en activant les macros.

Collez ce code où vous voulez et exécutez-le pour supprimer le nom défini :

Sub Supprimer_nom()
ThisWorkbook.Names("Fichier_original").Delete
End Sub

Supprimez ce code et enlevez le End de Workbook-Open.

Enregistrez le fichier, fermez-le, rouvrez-le et fermez-le, le nouveau nom est protégé.

A+

onjour,

Un grand merci à vous tous.

 

[EXCJPH]

Re : Empecher la copie d'un fichier

Bonjour BLACKHAYES, Speel, le forum,

Mettez cette macro dans ThisWorkbook (Alt+F11) :

Private Sub Workbook_Open()
Dim nomfich$
nomfich = ThisWorkbook.Path & "\" & Me.Name
If IsError([Fichier_original]) Then
  Me.Names.Add "Fichier_original", nomfich, Visible:=False
  Me.Save
Else
  If nomfich <> [Fichier_original] Then
    On Error Resume Next 'si le fichier original n'est pas trouvé
    Workbooks.Open [Fichier_original]
    Me.ChangeFileAccess xlReadOnly
    Kill nomfich 'suicide
    Me.Close False
  End If
End If
End Sub

Fermez le fichier, rouvrez-le pour que le nom "Fichier_original" soit créé, puis refermez-le.

Et maintenant faites-en une copie et essayez d'ouvrir cette copie...

Il s'agit d'un suicide

Notes :

- protégez avec mot de passe le VBA

- le fichier copié ne se suicide pas s'il est ouvert en lecture seule

- attention le fichier original se suicidera si on le rouvre après avoir changé son nom ou son répertoire

- bien sûr les macros doivent être activées...

A+

Bonjour job75 et ceux qui ont, à l'époque, participé à ce sujet.
En ce qui me concerne, j'ai vraiment du mal à comprendre. Particulièrement:
If IsError([Fichier_original]) Then
Au premier lancement du fichier dans son dossier d'origine, il y a bien une erreur mais au deuxième ,l'erreur à disparu. Bref c'est une petite explication dont j'ai besoin. ([Fichier_original]), de quoi s'agit-il ?
Si job75 qui est l'auteur peut m'explique, j'en serais ravi.
A+

 

[job75]

Bonjour EXCJPH,

Lors de la création du fichier, remplacez dans la macro Visible:=False par Visible:=True

De cette manière vous pourrez comprendre ce qui se passe avec le nom défini "Fichier_original".

A+

 

[patricktoulon]

bonjour
@job75
cette astuce a un gros défaut
mes fichiers pour le boulot sont sur une cle usb que je remporte bien sur tout les jours chez moi
sauf que au boulot ou chez moi des que je branche ma clé usb sa lettre de lecteur ne sera pas toujours la même
conclusion je ne peut pas ouvrir mon fichier selon si mon pc (chez moi ou au boulot) a d'autre disque externe déja connecté

j'ai eu une autre idée

 

[job75]

cette astuce a un gros défaut

Il n'y a vraiment aucune astuce.

 

[patricktoulon]

j'ai dans l'idée:
au lieu que d'utiliser le chemin dans le name
utiliser plutôt un code construit avec la date de création
après le principe c'est le tien
je laisse le name visible pour l'exemple

Private Sub Workbook_Open()
    If IsError([secu]) Then
        Me.Names.Add "secu", getcode, Visible:=True
        ThisWorkbook.Save
    Else
        MsgBox getcode & vbCrLf & [secu]
        If Val(getcode) <> Val([secu]) Then MsgBox "ceci est une copie du fichier"
    End If
End Sub
Function getcode()
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    getcode = Replace(CDbl((fs.GetFile(ThisWorkbook.FullName).DateCreated)), ",", "")
End Function

 

[EXCJPH]

Bonjour EXCJPH,

Lors de la création du fichier, remplacez dans la macro Visible:=False par Visible:=True

De cette manière vous pourrez comprendre ce qui se passe avec le nom défini "Fichier_original".

A+

Bonjour job75,
J'abuse, surement...
j'ai beau remplacer dans la macro Visible:=False par Visible:=True, je ne saisi pas la subtilité. Toujours autodidacte sur VBA, il y a des chose qui m'échappent. ([Fichier_original]): A quoi servent les crochets ?
Pourquoi le résultat de If IsError est vrai lors du premier lancement du fichier, puis faux aux suivants ?
Votre code fonctionne à merveille et va m'être très utile mais sans le comprendre je ne peut le mettre en fonction. Je ne souhaite pas tuer le fichier mais informer le copieur de son action illégitime.
Bref quelques précisions me seraient les bien venues si votre temps le permet.
Bonne journée job75

 

[job75]

Bonjour le forum,

A quoi servent les crochets ?

Les crochets font évaluer l'expression, c'est la même chose que la fonction Evaluate.

A+

 

[Goose]

Bjr Job,
peux tu suivre le post suivant ?
https://excel-downloads.com/threads/afficher-le-service-au-tennis-de-table.20077756/page-2#posts
merci d'avance

 

[job75]

Bonjour Goose,

Merci pour le lien, je n'avais pas vu passer votre dernier message.

Dans ces cas là il vaut mieux envoyer un message privé (conversation).

A+

 

[patricktoulon]

Bonjour @job75 tu me diras ce que tu en pense
je reviens un peu sur ton exemple en post#4 de 2014
et le problème provoqué quand on travaille avec des fichier sur clé USB
en effet quand tu enregistre dans le names le fullname du classeur(chemin complet)
1° il arrive que les clés usb n'ont pas toujours la même lettre de disque selon l'ordre dans le quel ells sont connectées
2° d'autre part il est possible que le travail sur ces fichiers se fasse à la maison et au boulot
ce qui fait que que le full path empêcherait l'utilisation du fichier

j'ai donc concocter 2 solutions
1 avec un serial code fulldate created qui empêche toute copie(d'une manière ou d'une autre )
le fichier pourra toujours être déplacé

Private Sub Workbook_Open()
    If IsError([secu]) Then
        Me.Names.Add "secu", getcode, Visible:=True
        ThisWorkbook.Save
    Else
        MsgBox getcode & vbCrLf & [secu]
        If Val(getcode) <> Val([secu]) Then A_faire
    End If
End Sub
Function getcode()
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    getcode = Replace(CDbl((fs.GetFile(ThisWorkbook.FullName).DateCreated)), ",", "")
End Function

Sub A_faire()
MsgBox "ce fichier est une copie interdite" & vbCrLf & "Destruction du fichier"
End Sub

2 avec le serial date +pcname+username de l'application
qui empêche tout utilisation ailleurs que sur un (disque dur du pc; n'importe le quel bien sur )
il sera donc impossible d'utiliser ce fichier sur un autre pc

Private Sub Workbook_Open()
    If IsError([secu]) Then
        Me.Names.Add "secu", getcode, Visible:=True
        ThisWorkbook.Save
    Else
        MsgBox getcode & vbCrLf & [secu]
        If Val(getcode) <> Val([secu]) Then A_faire
    End If
End Sub
Function getcode()
    Dim fs, f, s, Cde$
    Set fs = CreateObject("Scripting.FileSystemObject")
    Cde = Replace(CDbl((fs.GetFile(ThisWorkbook.FullName).DateCreated)), ",", "")
    Cde = Cde & Environ("computername")
    Cde = Cde & Application.UserName
getcode = Cde
End Function

Sub A_faire()
    MsgBox "ce fichier est une copie interdite" & vbCrLf & "Destruction du fichier"
'destruction des modules
'vidage des cellules
'etc etc ....
End Sub

 

[job75]

Bonjour Patrick,

Bonjour @job75 tu me diras ce que tu en pense

Ce fil ne m'intéresse plus du tout mais quelqu'un d'intéressé va sûrement te répondre.

A+

 

[Staple1600]

Bonjour le fil

@patricktoulon
Sauf erreur, Excel permettant d'ouvrir un classeur sans activer les macros.
Tout est possible (avec ou sans serial code full date et tutti quanti)

Tout comme job75 (que je salue), je laisse ce fil retourner dormir dans la poussière de 2014.