disable cut copy paste and have an exception

S

shadowplay

New Member
Joined
Aug 8, 2008
Messages
13
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 ***
Code: 
[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 ***

Code: 
[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]
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
thanks jkpieterse for this option however i dont want the user to be able to overwrite the details.

Therefore the code i have used does work the way i want it to i just want the user to be able to copy and paste in only one colomn (E)
 
Upvote 0
My code only disallows normal paste operations, it does not prevent copying or cutting indeed.

But you can use the "MyPasteValues" routine to determine what to do, based on the current selection.
 
Upvote 0
sorry perhaps i am a bit dim when it comes to VBA but can't i just add a range that is exempt to the vba script that i already have?
 
Upvote 0
this script is also an option but again i cannot specify a range that this rule does not apply to.

Any soloutions would be great

Code: 
Option Explicit

Sub EnableControl(Id As Integer, Enabled As Boolean)
Dim CB As CommandBar
Dim C As CommandBarControl
For Each CB In Application.CommandBars
Set C = CB.FindControl(Id:=Id, recursive:=True)
If Not C Is Nothing Then C.Enabled = Enabled
Next
End Sub

Private Sub Workbook_Activate()
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Deactivate()
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Open()
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub
 
Upvote 0
Probeer dit eens:

Code: 
Option Explicit

Private mbEnabled As Boolean

Private Sub Workbook_Activate()
    EnableOrNot
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    EnableCutCopyPaste
End Sub

Private Sub Workbook_Deactivate()
    EnableCutCopyPaste
End Sub

Private Sub Workbook_Open()
    EnableOrNot
End Sub

Private Sub EnableOrNot()
    With ActiveCell
        If .Parent.Name = "Sheet1" Then
            'Alleen werkblad Sheet1
            If .Column = 5 Then
                If Not mbEnabled Then
                    EnableCutCopyPaste
                End If
            Else
                DisableCutCopyPaste
            End If
        Else
            If Not mbEnabled Then
                EnableCutCopyPaste
            End If
        End If
    End With
End Sub

Private Sub DisableCutCopyPaste()
    EnableControl 21, False    ' cut
    EnableControl 19, False    ' copy
    EnableControl 22, False    ' paste
    EnableControl 755, False    ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
    mbEnabled = False
End Sub

Private Sub EnableCutCopyPaste()
    EnableControl 21, True    ' cut
    EnableControl 19, True    ' copy
    EnableControl 22, True    ' paste
    EnableControl 755, True    ' pastespecial
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "+{DEL}"
    Application.OnKey "+{INSERT}"
    Application.CellDragAndDrop = True
    mbEnabled = True
End Sub

Sub EnableControl(Id As Integer, Enabled As Boolean)
    Dim CB As CommandBar
    Dim C As CommandBarControl
    For Each CB In Application.CommandBars
        Set C = CB.FindControl(Id:=Id, recursive:=True)
        If Not C Is Nothing Then C.Enabled = Enabled
    Next
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    EnableOrNot
End Sub
 
Upvote 0
jkpieterse said:
Probeer dit eens:

Code: 
Option Explicit
 
Private mbEnabled As Boolean
 
Private Sub Workbook_Activate()
    EnableOrNot
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    EnableCutCopyPaste
End Sub
 
Private Sub Workbook_Deactivate()
    EnableCutCopyPaste
End Sub
 
Private Sub Workbook_Open()
    EnableOrNot
End Sub
 
Private Sub EnableOrNot()
    With ActiveCell
        If .Parent.Name = "Sheet1" Then
            'Alleen werkblad Sheet1
            If .Column = 5 Then
                If Not mbEnabled Then
                    EnableCutCopyPaste
                End If
            Else
                DisableCutCopyPaste
            End If
        Else
            If Not mbEnabled Then
                EnableCutCopyPaste
            End If
        End If
    End With
End Sub
 
Private Sub DisableCutCopyPaste()
    EnableControl 21, False    ' cut
    EnableControl 19, False    ' copy
    EnableControl 22, False    ' paste
    EnableControl 755, False    ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
    mbEnabled = False
End Sub
 
Private Sub EnableCutCopyPaste()
    EnableControl 21, True    ' cut
    EnableControl 19, True    ' copy
    EnableControl 22, True    ' paste
    EnableControl 755, True    ' pastespecial
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "+{DEL}"
    Application.OnKey "+{INSERT}"
    Application.CellDragAndDrop = True
    mbEnabled = True
End Sub
 
Sub EnableControl(Id As Integer, Enabled As Boolean)
    Dim CB As CommandBar
    Dim C As CommandBarControl
    For Each CB In Application.CommandBars
        Set C = CB.FindControl(Id:=Id, recursive:=True)
        If Not C Is Nothing Then C.Enabled = Enabled
    Next
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    EnableOrNot
End Sub
Click to expand...


Thanks for this however i can't seem to get it to work at all.
Where would i need to add this script?
Does it require another part a of a script to be added somewhere else>
 
Upvote 0
The proposed code will clean up the clipboard’s content for Sheet1 to prevent paste operation after cut or copy one.
It blocks any paste operation even via Ctrl-V in cells after Ctrl-C in formula bar.
The exception is E-column in which cut-copy-paste operations are available if the active cell is still in this column.

Put all the code to ThisWorkbook module.
Set reference: VBE - Tools - References - Microsoft Forms 2.0 Object library
or just add/remove empty UserForm to autoset that reference.
Code can be used in Excel 2003 as well as in Excel 2007, 2010

Rich (BB code): 

' 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 Sheet1 in the code by required sheet's CodeName

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 Sheet1 Then EmptyClipboard
End Sub

' Empty clipboard at activation of Sheet1 from another sheet of this workbook
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Sh Is Sheet1 Then EmptyClipboard
End Sub

' Code for changing selection in Sheet1
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 Sheet1 Then EmptyClipboard: Exit Sub
  
  Const ColumnE& = 5  ' <-- number of column E where exception is applied, change to suit
  
  If Not Sh Is Sheet1 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

Regards
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
Disable Cut Copy Paste
Replies
1
Views
858
jkpieterse
jkpieterse
F
  • Question Question
Combine Disable copy paste VBA & force run Macro
Replies
1
Views
5K
faizanmariner
F
C
  • Solved
Copy paste columns based on matching header into another workbook
Replies
5
Views
295
mumps
mumps
S
  • Question Question
Restrict Copy, Paste Drag ina certain range, in certain sheet.
Replies
2
Views
4K
salta301
S
Jaafar Tribak
  • Question Question
Capturing the Paste Event (API Hooking - Redirection)
Replies
4
Views
850
Jaafar Tribak
Jaafar Tribak

Forum statistics

Threads
1,224,600
Messages
6,179,834
Members
452,947
Latest member
Gerry_F

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top