interdire copier/coller

[jo]

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).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

 

[wilfried]

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

 

[jo]

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

@ +

 

[Biganass]

Re : interdire copier/coller

Bonjour,

je voudrais savoir, par rapport à Excel 2010, il y à toujours l'onglet "Presse-papiers" sur la barre d'outils qui est activer
et qui permet le copier coller, est-ce-qu'il y à une solution pour cela ???

Merci d'avance !!!

 

[tototiti2008]

Re : interdire copier/coller

Bonjour Biganass,

Bienvenue sur XLD,

ça vaut ce que ça vaut, mais moi pour empêcher le copier/coller, je mettrais ce code dans Thisworkbook

à tester

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Application.CutCopyMode = False
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    Application.CutCopyMode = False
End Sub

 

[Biganass]

Re : interdire copier/coller

Merci pour votre réponse mais malheureusement la boite "presse papier" est toujours activée !!!

Merci !!!

 

[tototiti2008]

Re : interdire copier/coller

Re,

Pas d'Excel 2010 sous la main
Même s'il est activé, est-il possible de copier/coller ?

 

[Biganass]

Re : interdire copier/coller

oui oui exactement, le copier coller qu'on trouve sur la barre d'outil, contrairement au clic droit, il marche !!!!

 

[Mohamed Amin]

Bonjour je veux interdire le copier coller sur une seule feuille Excel et les autres restes comme c'était sans changement