Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Empêcher le copier coller sauf ...

Empêcher le copier coller sauf ...

2 réponses
Avatar
Patrick BASTARD
Bonjour, vous.

Grâce à votre aide, j'ai le code ci-dessous qui fonctionne bien, pour
inhiber les copier-coller, collage spécial, recopie vers le bas ....

Pour l'améliorer encore, à la demande de l'utilisateur, je voudrais
maintenir la possibilité de copier (uniquement copier) les données contenues
dans les colonnes W et AD.

Quelle serait votre suggestion ?

Merci d'avance,


--
Bien cordialement,
P. Bastard

...................................................................................................
Private Sub Workbook_Activate()
On Error Resume Next

With Application
'disables shortcut keys
.OnKey "^x", ""
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^b", ""
.OnKey "^d", ""
.CellDragAndDrop = False

'Disables Copy
.CommandBars("Edit").FindControl(ID:=19).Enabled = False
.CommandBars("Edit").FindControl(ID:=21).Enabled = False
.CommandBars("Edit").FindControl(ID:=22).Enabled = False
.CommandBars("Edit").FindControl(ID:=755).Enabled = True
.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("Standard").FindControl(ID:=19).Enabled = False
.CommandBars("Ply").FindControl(ID:=848).Enabled = False
End With
End Sub

...................................................................................................
Private Sub Workbook_Deactivate()
On Error Resume Next
Application.CellDragAndDrop = True

With Application
.OnKey "^x"
.OnKey "^c"
.OnKey "^v"
.OnKey "^b"
.OnKey "^d"

'Enables Copy
.CommandBars("Edit").FindControl(ID:=19).Enabled = True
.CommandBars("Edit").FindControl(ID:=21).Enabled = True
.CommandBars("Edit").FindControl(ID:=22).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("Standard").FindControl(ID:=19).Enabled = True
.CommandBars("Ply").FindControl(ID:=848).Enabled = True
End With
End Sub
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Finopat
Bonjour,
voici ce que je te propose : autoriser le copier sur un clic droit :
à placer dans le code associé à la feuille sur laquelle
tu veux autoriser le copier.
Je ne suis pas capable de faire plus concis, désolé ...

----------------------------------------------------------------------------------------

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel
As Boolean)
Cancel = True
Dim Mbar As CommandBar, Ctrl As CommandBarControl
Set Mbar = Application.CommandBars("Cell")

'Gestion CLIC DROIT
If Not Intersect(Target, Range("W:W")) Is Nothing Then 'clic dans colonne
autorisée
'si clic droit dans colonne W
With Mbar
.FindControl(Id:).Enabled = True 'copier
.FindControl(Id:!).Enabled = False 'couper
.FindControl(Id:").Enabled = False 'coller
.FindControl(Id:u5).Enabled = False 'collage spécial
.ShowPopup
End With

ElseIf Not Intersect(Target, Range("AD:AD")) Is Nothing Then 'clic dans
colonne autorisée
'si clic droit dans colonne AD
With Mbar
.FindControl(Id:).Enabled = True 'copier
.FindControl(Id:!).Enabled = False 'couper
.FindControl(Id:").Enabled = False 'coller
.FindControl(Id:u5).Enabled = False 'collage spécial
.ShowPopup
End With

Else 'clic dans autres colonnes

With Mbar
.FindControl(Id:).Enabled = False 'copier
.FindControl(Id:!).Enabled = False 'couper
.FindControl(Id:").Enabled = False 'coller
.FindControl(Id:u5).Enabled = False 'collage spécial
.ShowPopup
End With
End If
End Sub
Avatar
Patrick BASTARD
Bonjour, *Finopat*
J'ai lu ton post
avec le plus grand intéret :

Tout ça me semble bien engagé, ma foi.

Les premiers tests sont en effet concluents.

Je te remercie,


--
Bien cordialement,
P. Bastard




Bonjour,
voici ce que je te propose : autoriser le copier sur un clic droit :
à placer dans le code associé à la feuille sur laquelle
tu veux autoriser le copier.
Je ne suis pas capable de faire plus concis, désolé ...

----------------------------------------------------------------------------------------

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range,
Cancel As Boolean)
Cancel = True
Dim Mbar As CommandBar, Ctrl As CommandBarControl
Set Mbar = Application.CommandBars("Cell")

'Gestion CLIC DROIT
If Not Intersect(Target, Range("W:W")) Is Nothing Then 'clic dans
colonne autorisée
'si clic droit dans colonne W
With Mbar
.FindControl(Id:).Enabled = True 'copier
.FindControl(Id:!).Enabled = False 'couper
.FindControl(Id:").Enabled = False 'coller
.FindControl(Id:u5).Enabled = False 'collage spécial
.ShowPopup
End With

ElseIf Not Intersect(Target, Range("AD:AD")) Is Nothing Then 'clic
dans colonne autorisée
'si clic droit dans colonne AD
With Mbar
.FindControl(Id:).Enabled = True 'copier
.FindControl(Id:!).Enabled = False 'couper
.FindControl(Id:").Enabled = False 'coller
.FindControl(Id:u5).Enabled = False 'collage spécial
.ShowPopup
End With

Else 'clic dans autres colonnes

With Mbar
.FindControl(Id:).Enabled = False 'copier
.FindControl(Id:!).Enabled = False 'couper
.FindControl(Id:").Enabled = False 'coller
.FindControl(Id:u5).Enabled = False 'collage spécial
.ShowPopup
End With
End If
End Sub