disable cut copy paste and have an exception

[shadowplay]

Hi,

I have found the following code and it works a treat, however i would like to let my user copy and pase only in column E.
How can I adjust my code to make this possible?

*** In a standard module ***

[COLOR=#0000ff]Option Explicit[/COLOR] 
 
[COLOR=blue]Sub[/COLOR] ToggleCutCopyAndPaste(Allow [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR]) 
     [COLOR=darkgreen]'Activate/deactivate cut, copy, paste and pastespecial menu items[/COLOR]
    [COLOR=blue]Call[/COLOR] EnableMenuItem(21, Allow) [COLOR=darkgreen]' cut[/COLOR]
    [COLOR=blue]Call[/COLOR] EnableMenuItem(19, Allow) [COLOR=darkgreen]' copy[/COLOR]
    [COLOR=blue]Call[/COLOR] EnableMenuItem(22, Allow) [COLOR=darkgreen]' paste[/COLOR]
    [COLOR=blue]Call[/COLOR] EnableMenuItem(755, Allow) [COLOR=darkgreen]' pastespecial[/COLOR]
     
     [COLOR=darkgreen]'Activate/deactivate drag and drop ability[/COLOR]
    Application.CellDragAndDrop = Allow 
     
     [COLOR=darkgreen]'Activate/deactivate cut, copy, paste and pastespecial shortcut keys[/COLOR]
    [COLOR=blue]With[/COLOR] Application 
        [COLOR=blue]Select Case[/COLOR] Allow 
        [COLOR=blue]Case[/COLOR] [COLOR=blue]Is[/COLOR] = [COLOR=blue]False[/COLOR] 
            .OnKey "^c", "CutCopyPasteDisabled" 
            .OnKey "^v", "CutCopyPasteDisabled" 
            .OnKey "^x", "CutCopyPasteDisabled" 
            .OnKey "+{DEL}", "CutCopyPasteDisabled" 
            .OnKey "^{INSERT}", "CutCopyPasteDisabled" 
        [COLOR=blue]Case[/COLOR] [COLOR=blue]Is[/COLOR] = [COLOR=blue]True[/COLOR] 
            .OnKey "^c" 
            .OnKey "^v" 
            .OnKey "^x" 
            .OnKey "+{DEL}" 
            .OnKey "^{INSERT}" 
        [COLOR=blue]End Select[/COLOR] 
    [COLOR=blue]End With[/COLOR] 
[COLOR=blue]End Sub[/COLOR] 
 
[COLOR=blue]Sub[/COLOR] EnableMenuItem(ctlId [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR], Enabled [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR]) 
     [COLOR=darkgreen]'Activate/Deactivate specific menu item[/COLOR]
    [COLOR=blue]Dim[/COLOR] cBar [COLOR=blue]As[/COLOR] CommandBar 
    [COLOR=blue]Dim[/COLOR] cBarCtrl [COLOR=blue]As[/COLOR] CommandBarControl 
    [COLOR=blue]For Each[/COLOR] cBar [COLOR=blue]In[/COLOR] Application.CommandBars 
        [COLOR=blue]If[/COLOR] cBar.Name <> "Clipboard" [COLOR=blue]Then[/COLOR] 
            [COLOR=blue]Set[/COLOR] cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=[COLOR=blue]True[/COLOR]) 
            [COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] cBarCtrl [COLOR=blue]Is[/COLOR] [COLOR=blue]Nothing[/COLOR] [COLOR=blue]Then[/COLOR] cBarCtrl.Enabled = Enabled 
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
    [COLOR=blue]Next[/COLOR] 
[COLOR=blue]End Sub[/COLOR] 
 
[COLOR=blue]Sub[/COLOR] CutCopyPasteDisabled() 
     [COLOR=darkgreen]'Inform user that the functions have been disabled[/COLOR]
    MsgBox "Sorry!  Cutting, copying and pasting have been disabled in this workbook!" 
[COLOR=blue]End Sub[/COLOR]

'*** In the ThisWorkbook Module ***

[COLOR=#0000ff]Option Explicit[/COLOR] 
 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_Activate() 
    [COLOR=blue]Call[/COLOR] ToggleCutCopyAndPaste([COLOR=blue]False[/COLOR]) 
[COLOR=blue]End Sub[/COLOR] 
 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_BeforeClose(Cancel [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR]) 
    [COLOR=blue]Call[/COLOR] ToggleCutCopyAndPaste([COLOR=blue]True[/COLOR]) 
[COLOR=blue]End Sub[/COLOR] 
 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_Deactivate() 
    [COLOR=blue]Call[/COLOR] ToggleCutCopyAndPaste([COLOR=blue]True[/COLOR]) 
[COLOR=blue]End Sub[/COLOR] 
 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_Open() 
    [COLOR=blue]Call[/COLOR] ToggleCutCopyAndPaste([COLOR=blue]False[/COLOR]) 
[COLOR=blue]End Sub[/COLOR]

 

[shadowplay]

thanks for all your help. but i still cant seem to get it to work.

I have attached the code that i have and that works for the whole workbook.
Pehaps if someone could adjust the code so that colom E still allows copy an paste that would be great.

The excel sheet is on the following link
https://www.filesanywhere.com/fs/v.aspx?v=8a6b648e5d676fb8a6af

 

[ZVI]

In your localization the code name of the 1st sheet is Blad1.
Therefore according to Note3 of my code comments (post #10) you need to replace Sheet1 by Blad1 in all code.
Also reference to Microsoft Forms 2.0 Object library is required - see Note1 in the code comments.

Your example with new code is downloadable from this link: testv2.xlsm

Switching of CellDragAndDrop property was added.

The updated code of the example now looks as follows:

' ZVI:2011-03-07 http://www.mrexcel.com/forum/showthread.php?t=533507
' Empty clipboard to prevent paste operation.
' The exception is E-column in which cut-copy-paste operations are available
' Reference required: VBE - Tools - References - Microsoft Forms 2.0 Object library
' Note1: simple way to set reference - add and then delete UserForm
' Note2: put the code below to ThisWorkbook module
' Note3: replace Blad1 in the code by required sheet's CodeName,
'        usually it's Sheet# code name where # is the munber of sheet

Dim MyDataObject As New DataObject
Dim OldTarget As Range

' Put empty string to the clipboard
Private Sub EmptyClipboard()
  With MyDataObject
    .SetText ""
    .PutInClipboard
    .Clear
  End With
  Set OldTarget = Nothing
End Sub

' Empty clipboard at activation of this workbook from another workbook
Private Sub Workbook_Activate()
  If ActiveSheet Is Blad1 Then
    EmptyClipboard
    Application.CellDragAndDrop = False
  Else
    Application.CellDragAndDrop = True
  End If
End Sub

' Restore CellDragAndDrop property
Private Sub Workbook_Deactivate()
  Application.CellDragAndDrop = True
End Sub

' Empty clipboard at activation of Blad1 from another sheet of this workbook
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Sh Is Blad1 Then
    EmptyClipboard
    Application.CellDragAndDrop = False
  Else
    Application.CellDragAndDrop = True
  End If
  
End Sub

' Code for changing selection in Blad1
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  
  ' Note: uncomment the line below to operate without exception for Column E
  'If Sh Is Blad1 Then EmptyClipboard: Exit Sub
  
  Const ColumnE& = 5  ' <-- number of column E where exception is applied, change to suit
  
  If Not Sh Is Blad1 Then Exit Sub
  
  With Target
    If .Columns.Count <> 1 Or .Column <> ColumnE Then EmptyClipboard
  End With
  
  If Not OldTarget Is Nothing Then
    With OldTarget
      If .Columns.Count <> 1 Or .Column <> ColumnE Then EmptyClipboard
    End With
  End If
  
  Set OldTarget = Target

End Sub

 

[shadowplay]

Hi ZVI

Thanks for this.
I understand now what you mean however it is more the case that the details would be copied from a different excel document and pasted in my document.
In this version they can only be copied and pasted from the same colomn.
Is it possible?

 

[ZVI]

Hi ZVI

Thanks for this.
I understand now what you mean however it is more the case that the details would be copied from a different excel document and pasted in my document.
In this version they can only be copied and pasted from the same colomn.
Is it possible?

Delete all previous code and put this one into the skeet (Blad1) module:

' Code of Sheet1 (Blad1)
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 5 And Target.Columns.Count = 1 Then Exit Sub
  With Application
    If .CutCopyMode Then
      .EnableEvents = False
      .Undo
      .EnableEvents = True
    End If
  End With
End Sub

Is this you are after?

 

[shadowplay]

absolutely brilliant.
that's it.
Would be great if a message could be given to the user that copy and paste is not allowed in the workbook however if this isn't possible then at least this script does what it needs to do.
Thank you so much

 

[ZVI]

I'm glad it did the job for you

The version with warning message:

' Code of Sheet1 (Blad1)
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 5 And Target.Columns.Count = 1 Then Exit Sub
  With Application
    If .CutCopyMode Then
      MsgBox "Paste is allowed only in E-column" & vbLf & _
             "Press OK to undo", vbExclamation, "Forbidden range to paste"
      .EnableEvents = False
      .Undo
      .EnableEvents = True
    End If
  End With
End Sub

Regards,
Vlad

 

[shadowplay]

Vlad, what can i say.
You are absolutely brilliant