Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Bonsoir
ben non c'est le but de la manœuvre
tu peux pas bloquer le "enregistrer sous "et demander de changer de nom
ou alors avec un imputbox en guise de message avec mot de passe
mais ta demande est quelque peu illogique
Merci pour ton retour.
Hier j'avais répondu mais depuis mon téléphone et cela n'a pas fonctionné visiblement.
Ce que je voulais savoir c'était la possibilité de reprendre la main sur le fichier si par exemple pour une quelconque raison on doit adapter le nom du fichier selon le client.
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 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
VB:
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
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
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é
VB:
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
VB:
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
@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.
re
quand tu a des feuilles veryhidden avec mot de passe feuille
et que tu bloque vba qui lui même a le project protégé
ben BON chance' si tu n'est pas un crack
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.