Copier / coller

[KAR_inette]

Il me semble qu'il existe une macro pour interdir le copier / Coller dans un classeur ....
Si quelqu'un s'en souvient ....
Merci d'@vance ...

 

[utilsfr]

A tester


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).Enabled = False
.CommandBars("Button").FindControl(ID:=848).Enabled = False
.CommandBars("Formula Bar").FindControl(ID:=848).Enabled = False
.CommandBars("Worksheet Menu Bar").FindControl(ID:=848).Enabled = False
.CommandBars("Standard").FindControl(ID:=848).Enabled = 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).Enabled = 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).Enabled = True
.CommandBars("Button").FindControl(ID:=848).Enabled = True
.CommandBars("Formula Bar").FindControl(ID:=848).Enabled = True
.CommandBars("Worksheet Menu Bar").FindControl(ID:=848).Enabled = True
.CommandBars("Standard").FindControl(ID:=848).Enabled = 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).Enabled = True

End With
End Sub

 

[KAR_inette]

Excelent !!!
ça marche très bien ....
Merci