Disable cut/copy/paste - but still be able to copy between workbooks??

[trosimon]

Hello everyone!

I have copied the "disable cut/paste code" found on this forum. (I am not allowed to post links...)

I only need the Cut part and have adjusted the code to my needs. But I have one big problem with the code. When I change to another workbook it is disabled, that's good. But if I would like to copy something back to the workbook from another workbook the code makes this impossible. It removes whatever I have copied. I can't have the Ctrl+x disabled in all workbooks so do anyone know of a solution to the problem?


Best regards,

Trond

[Ken Puls]

Welcome to VBAX, Trond.

This is a little messy, and can be cut down quite a bit, but give it a shot:

In the ThisWorkbook Module, adjust the code to read:
[vba]Option Explicit
'Create a worksheet with a name that you think will never be used, hide it
'then update "HiddenSheet" to the worksheet's name
Private Const sTempSheet = "HiddenSheet"
Private Sub Workbook_Activate()
Dim bCopyActive As Boolean
Select Case Application.CutCopyMode
Case Is = 1, 2
bCopyActive = True
End Select

With Worksheets(sTempSheet)
If bCopyActive Then
.Range("A1").Parent.Paste
Else
.Cells.ClearContents
End If
Call ToggleCutCopyAndPaste(False)
If bCopyActive Then Range(.Cells(1, 1), _
.Cells((.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row), _
(.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column))).Copy
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("Temp").Cells.ClearContents
Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Deactivate()
Worksheets("Temp").Cells.ClearContents
Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Open()
Dim bCopyActive As Boolean
Select Case Application.CutCopyMode
Case Is = 1, 2
bCopyActive = True
End Select

With Worksheets(sTempSheet)
If bCopyActive Then
.Range("A1").Parent.Paste
Else
.Cells.ClearContents
End If
Call ToggleCutCopyAndPaste(False)
If bCopyActive Then Range(.Cells(1, 1), _
.Cells((.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row), _
(.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column))).Copy
End With
End Sub[/vba]

And you can adjust the standard module's code to read as follows (or just cut out the commented lines):
[vba]Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
' Call EnableMenuItem(19, Allow) ' copy
' Call EnableMenuItem(22, Allow) ' paste
' Call EnableMenuItem(755, Allow) ' pastespecial

'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
' .OnKey "^c", "CutCopyPasteDisabled"
' .OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
' .OnKey "+{DEL}", "CutCopyPasteDisabled"
' .OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case Is = True
' .OnKey "^c"
' .OnKey "^v"
.OnKey "^x"
' .OnKey "+{DEL}"
' .OnKey "^{INSERT}"
End Select
End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub

Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox "Sorry! Cutting, copying and pasting have been disabled in this workbook!"
End Sub
[/vba]

Please note that it is very important that you insert a new worksheet with a weird name you're sure will never be used and hide the worksheet. Then update the constant at the top of the ThisWorkbook module to reflect that name.

This is necessary because we need a temporary home for the data since it will be cleared from the clipboard as soon as we disable the commands. You should have full pastespecial functionality with what you cut/copied from other workbooks though.

[Simon Lloyd]

Ken, wouldn't it be better to have it xlVeryHidden?

[Ken Puls]

Yeah, but I didn't have time to write up the code to do it automagically. Ideally the code should create a sheet with some weird nonsensical name if it doesn't exist and set it to xlVeryHidden. Ideally though, I shouldn't have the same code in the Workbook_Open and Workbook_Activate events too.

[Ken Puls]

Okay, so this should be better. No need to create the sheet any more, as the routine will do it for you. Hopefully the name should be random enough that no one will run into a conflict with it.

In the ThisWorkbook module:
[vba]Option Explicit
Private Sub Workbook_Activate()
Call SuppressCut
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets(sPasteTarget).Cells.ClearContents
Call ToggleCut(True)
End Sub
Private Sub Workbook_Deactivate()
Worksheets(sPasteTarget).Cells.ClearContents
Call ToggleCut(True)
End Sub
Private Sub Workbook_Open()
Dim wsPasteTarget As Worksheet
'Check if hidden paste target sheet exists
On Error Resume Next
Err.Number = 0
ThisWorkbook.Worksheets(sPasteTarget).Visible = xlSheetVeryHidden

'Create the worksheet if it does not already exist
If Err.Number <> 0 Then
wsPasteTarget = ThisWorkbook.Worksheets.Add
With wsPasteTarget
.Name = sPasteTarget
.Visible = xlSheetVeryHidden
End With
End If
On Error GoTo 0

'Suppress the cut
Call SuppressCut
End Sub[/vba]

And in the Standard module:
[vba]Option Explicit
Public Const sPasteTarget As String = "^P@5t3T@rg37^"
Sub SuppressCut()
'This routine is required as a loader for the "ToggleCut" routine if the user wants to
'preserve data on the clipboard to copy INTO the workbook. To do this, we need to
'temporarily write the data to a worksheet as disabling the cut/copy/paste buttons
'clears the clipboard. Writing to a temp sheet allows us to copy the data again once
'the buttons have been deactivated.
Dim bCopyActive As Boolean

'Check if the clipboard contains an entry to be pasted
Select Case Application.CutCopyMode
Case Is = 1, 2
bCopyActive = True
End Select

With Worksheets(sPasteTarget)
If bCopyActive Then
'Paste data to a hidden sheet
.Range("A1").Parent.Paste
Else
'Clear the cells on the hidden sheet (for future use)
.Cells.ClearContents
End If

'Toggle the cut (and possibly other) command(s)
Call ToggleCut(False)

'If the clipboard had data, then copy the pasted data from the hidden sheet
'Note that we need to extract from the begging to the end of the data range, which
'may be different from the used range if multiple copies have been done in the same
'session
If bCopyActive Then Range(.Cells(1, 1), _
.Cells((.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row), _
(.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column))).Copy
End With
End Sub
Sub ToggleCut(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
' Call EnableMenuItem(19, Allow) ' copy
' Call EnableMenuItem(22, Allow) ' paste
' Call EnableMenuItem(755, Allow) ' pastespecial

'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
' .OnKey "^c", "CutCopyPasteDisabled"
' .OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
' .OnKey "+{DEL}", "CutCopyPasteDisabled"
' .OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case Is = True
' .OnKey "^c"
' .OnKey "^v"
.OnKey "^x"
' .OnKey "+{DEL}"
' .OnKey "^{INSERT}"
End Select
End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub

Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox "Sorry! Cutting, copying and pasting have been disabled in this workbook!"
End Sub[/vba]