interdire copier/coller

Bonjour,

je vous sollicite afin d'affiner une macro. Elle interdit le couper-copier et fonctionne très bien.
Cependant, je souhaiterai qu'elle n'agisse que lorsque le fichier, à partir duquel je l'ai lancée, est ouvert. Donc qu'elle n'agisse pas quand celui ci est fermé.
En effet, je ne veux pas bloquer le système des personnes à qui je communique le fichier pour lecture et qui n'ont pas accès à ce dispositif de protection.

Merci à vous qui pouvez avoir une idée de me la communiquer....


voici la macro en question :

Sub InterdireCopierCouper()
On Error Resume Next
With Application
'disables shortcut keys
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
'Disables Copy
.CommandBars("Edit").FindControl(Id:=19).Enabled = False
.CommandBars("Edit").FindControl(Id:=848).Enabled = False
.CommandBars("Cell").FindControl(Id:=19).Enabled = False
.CommandBars("Column").FindControl(Id:=19).Enabled = False
.CommandBars("Row").FindControl(Id:=19).Enabled = False
.CommandBars("Button").FindControl(Id:=19).Enabled = False
.CommandBars("Formula Bar").FindControl(Id:=19).Enabled = False
.CommandBars("Worksheet Menu Bar").FindControl(Id:=19).Enabled = False
.CommandBars("Standard").FindControl(Id:=19).Enabl ed = False
.CommandBars("Button").FindControl(Id:=848).Enable d = False
.CommandBars("Formula Bar").FindControl(Id:=848).Enabled = False
.CommandBars("Worksheet Menu Bar").FindControl(Id:=848).Enabled = False
.CommandBars("Standard").FindControl(Id:=848).Enab led = False
.CommandBars("Ply").FindControl(Id:=848).Enabled = False
'Disables Cut
.CommandBars("Edit").FindControl(Id:=21).Enabled = False
.CommandBars("Cell").FindControl(Id:=21).Enabled = False
.CommandBars("Column").FindControl(Id:=21).Enabled = False
.CommandBars("Row").FindControl(Id:=21).Enabled = False
.CommandBars("Button").FindControl(Id:=21).Enabled = False
.CommandBars("Formula Bar").FindControl(Id:=21).Enabled = False
.CommandBars("Worksheet Menu Bar").FindControl(Id:=21).Enabled = False
.CommandBars("Standard").FindControl(Id:=21).Enabl ed = False

End With
End Sub

Sub RetablirCopierCouper()
On Error Resume Next
With Application
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"

'Enables Copy
.CommandBars("Edit").FindControl(Id:=19).Enabled = True
.CommandBars("Edit").FindControl(Id:=848).Enabled = True
.CommandBars("Cell").FindControl(Id:=19).Enabled = True
.CommandBars("Column").FindControl(Id:=19).Enabled = True
.CommandBars("Row").FindControl(Id:=19).Enabled = True
.CommandBars("Button").FindControl(Id:=19).Enabled = True
.CommandBars("Formula Bar").FindControl(Id:=19).Enabled = True
.CommandBars("Worksheet Menu Bar").FindControl(Id:=19).Enabled = True
.CommandBars("Standard").FindControl(Id:=19).Enabl ed = True
.CommandBars("Button").FindControl(Id:=848).Enable d = True
.CommandBars("Formula Bar").FindControl(Id:=848).Enabled = True
.CommandBars("Worksheet Menu Bar").FindControl(Id:=848).Enabled = True
.CommandBars("Standard").FindControl(Id:=848).Enab led = True
.CommandBars("Ply").FindControl(Id:=848).Enabled = True
' Enables Cut
.CommandBars("Edit").FindControl(Id:=21).Enabled = True
.CommandBars("Cell").FindControl(Id:=21).Enabled = True
.CommandBars("Column").FindControl(Id:=21).Enabled = True
.CommandBars("Row").FindControl(Id:=21).Enabled = True
.CommandBars("Button").FindControl(Id:=21).Enabled = True
.CommandBars("Formula Bar").FindControl(Id:=21).Enabled = True
.CommandBars("Worksheet Menu Bar").FindControl(Id:=21).Enabled = True
.CommandBars("Standard").FindControl(Id:=21).Enabl ed = True

End With
End Sub

Salut Jo,

Si tu veux que cela s'applique automatiquement à l'ouverture de ton fichiers :

dans VBA, tu double clique sur thisworkbooks, tu selectionne dans le menu déroulant (général) workbooks et dans déclaration open :

Private sub workbook_open
Call InterdireCopierCouper
end sub

pour rétablir auto

tu choisit beforeclose

Private sub workbook_BeforeClose(Cancel as boolean)
Call RetablirCopierCouper
end sub

Voila tous

Wilfried

Merci Wilfried pour cette réponse qui fonctionne à merveille.

@ +