Disabling/Enabling Cut,Copy and Paste

[Phil1981]

I am trying to create a spreadsheet that forces people to use a button to paste data into as this way it will paste where and how I want it to.

The issue I am having is that after disabling cut,copy and paste function ... I then call my function to enable it again when the user has clicked the button which is clearing the copy they previous did.

I need the user to copy raw data from one sheet ... click the button to run a macro to paste it into another sheet where I want it to go and make sure that the users can not manually paste it where ever they would like.

The code I am using is below

This workbook

Option Explicit
Private Sub Workbook_Activate()
Call ToggleCutCopyAndPaste(False)
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleCutCopyAndPaste(True)
End Sub
 
Private Sub Workbook_Deactivate()
Call ToggleCutCopyAndPaste(True)
End Sub
 
Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
End Sub

Module1

Option Explicit
 
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
Sub PasteValues()
'On Error GoTo MsgTryAgain
Call ToggleCutCopyAndPaste(True)
Range("D2").Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'MsgTryAgain: MsgBox "Please try to copy the original data again and click the button to paste"
End Sub

Any help or suggestions would be appreciated

 

[Jaafar Tribak]

You are disabling the ability to copy as well so no data can be copied.

Try editing the ToggleCutCopyPaste routine to allow copying .