Disable cut/paste in ribbon and short cut

C

chrism1

New Member
Joined
Mar 20, 2012
Messages
12
<TABLE style="BORDER-BOTTOM: rgb(228,237,246) 1px solid; BORDER-LEFT: rgb(228,237,246) 1px solid; WIDTH: 98%; BORDER-TOP: rgb(228,237,246) 1px solid; BORDER-RIGHT: rgb(228,237,246) 1px solid" cellSpacing=0 align=center><TBODY><TR><TD>



</TD></TR><TR><TD></TD></TR><TR><TD style="BACKGROUND: rgb(228,237,246)"></TD></TR></TBODY></TABLE>
The following code will disable copy/paste from both the short cut keys and ribbon. It includes a message box to notify the user that right click has been disabled. I would like to know how to add code to include a message box to notify the user that cut/copy has been disabled when the shortcut keys (control x/control c) are used. I have tried various things, but am not skilled in this area. Thank you!

Private Sub Workbook_Activate()
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_Deactivate()
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"Cannot copy or ''drag & drop''.", 16, "For this workbook:"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Application.CutCopyMode = False
End Sub <!-- / message --><!-- sig --><!-- / message --><!-- sig -->
 
Last edited:
Sort by date Sort by votes
I'm going to look at the links you posted further. Should I continue to post here, or start a new thread in the event I need to see f someone can test 2010? Thank you AlphaFrog for all your help. I appreciate it.
 
Upvote 0

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
This is the code to force macros. Per the instructions, it is to be placed in the workbook.

Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets
Call HideAllSheets

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

However, the following code is also to be placed in the workbook:

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"Cannot copy or ''drag & drop''.", 16, "For this workbook:"
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Application.CutCopyMode = False
End Sub
Dim MyDataObject As New DataObject
Dim OldTarget As Range
Dim MyDataObject As New DataObject
Dim OldTarget As Range
Private Sub CommandButton1_Click()
Range("A1").Copy
Range("A2").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End Sub

I have tried to put them both into the workbook, in various order, but it is not working. I ran into this before and could not find the solution. Can you put 2 different sets of code into 1 workbook? If so, how?

Thank you.
 
Upvote 0
Surround your code with code tags (see my signature block below). It makes reading your questions much easier.
 
Upvote 0
This is the code to force macros. Per the instructions, it is to be placed in the workbook.

Code: 
Option Explicit 

Const WelcomePage = "Macros" 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
'Turn off events to prevent unwanted loops
Application.EnableEvents = False 

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook 
If Not .Saved Then 
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _ 
vbYesNoCancel + vbExclamation) 
Case Is = vbYes 
'Call customized save routine
Call CustomSave 
Case Is = vbNo 
'Do not save
Case Is = vbCancel 
'Set up procedure to cancel close
Cancel = True 
End Select 
End If 

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then 
.Saved = True 
Application.EnableEvents = True 
.Close savechanges:=False 
Else 
Application.EnableEvents = True 
End If 
End With 
End Sub 

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
'Turn off events to prevent unwanted loops
Application.EnableEvents = False 

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI) 
Cancel = True 

'Turn events back on an set saved property to true
Application.EnableEvents = True 
ThisWorkbook.Saved = True 
End Sub 

Private Sub Workbook_Open() 
'Unhide all worksheets
Application.ScreenUpdating = False 
Call ShowAllSheets 
Application.ScreenUpdating = True 
End Sub 

Private Sub CustomSave(Optional SaveAs As Boolean) 
Dim ws As Worksheet, aWs As Worksheet, newFname As String 
'Turn off screen flashing
Application.ScreenUpdating = False 

'Record active worksheet
Set aWs = ActiveSheet 

'Hide all sheets
Call HideAllSheets 

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then 
newFname = Application.GetSaveAsFilename( _ 
fileFilter:="Excel Files (*.xls), *.xls") 
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname 
Else 
ThisWorkbook.Save 
End If 

'Restore file to where user was
Call ShowAllSheets 
aWs.Activate 

'Restore screen updates
Application.ScreenUpdating = True 
End Sub 

Private Sub HideAllSheets() 
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet 

Worksheets(WelcomePage).Visible = xlSheetVisible 

For Each ws In ThisWorkbook.Worksheets 
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden 
Next ws 

Worksheets(WelcomePage).Activate 
End Sub 

Private Sub ShowAllSheets() 
'Show all worksheets except the macro welcome page

Dim ws As Worksheet 

For Each ws In ThisWorkbook.Worksheets 
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible 
Next ws 

Worksheets(WelcomePage).Visible = xlSheetVeryHidden 
End Sub

However, the following code is also to be placed in the workbook:

Code: 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"Cannot copy or ''drag & drop''.", 16, "For this workbook:"
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Application.CutCopyMode = False
End Sub
Dim MyDataObject As New DataObject
Dim OldTarget As Range
Dim MyDataObject As New DataObject
Dim OldTarget As Range
Private Sub CommandButton1_Click()
Range("A1").Copy
Range("A2").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End Sub

I have tried to put them both into the workbook, in various order, but it is not working. I ran into this before and could not find the solution. Can you put 2 different sets of code into 1 workbook? If so, how?

Thank you.
<!-- / message -->
 
Upvote 0
All that code goes in the ThisWorkbook code module.

This part has to go at the very top of the code module.
Code: 
Option Explicit 

Const WelcomePage = "Macros"

Each of the event procedures (Sub....End Sub) can go in any order. You cannot have two of the same event procedures e.g.; you cannot have two
Private Sub Workbook_BeforeClose procedures.

It doesn't look like there are duplicate event procedures in your code above. So you should be able to have all that code located in the ThisWorkbook code module. There may be other issues with the code as I haven't tested it.

Events And Event Procedures In VBA
Meaning and Use of Option Explicit
 
Upvote 0
I have been able to have co-workers look at this and it appears to work thus far.

However, I now have another question. I would like to disable "copy" from the ribbon.

I found the following code on the internet:

Code: 
[COLOR=blue][COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Workbook_Open()
  Application.OnKey [COLOR=#a31515]"^c"[/COLOR], [COLOR=#a31515]""[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
 
[/COLOR]


It will not work. Per one of your prior posts, I think it is because this is a duplicate event procedure. If so, would you know of a way to modify?

Also, I have my macro settings set to disable with notification so that I could test my hidden welcome sheet. It worked the first time, i.e. I then had to enable macros before the other sheets in my workbook could be viewed. However, when I open the workbook again, macros continue to appear enabled even though they are not, per my settings. Any ideas on this?

Thank you!
 
Upvote 0
Please disregard prior post re:


Code: 
Private Sub Workbook_Open()
Code: 
Application.OnKey "^c", ""
End Sub


I have the following code in ThisWorkbook:

Code: 
[CODE] 
Option Explicit 
 
Const WelcomePage = "Macros" 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
'Turn off events to prevent unwanted loops
Application.EnableEvents = False 
 
'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook 
If Not .Saved Then 
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _ 
vbYesNoCancel + vbExclamation) 
Case Is = vbYes 
'Call customized save routine
Call CustomSave 
Case Is = vbNo 
'Do not save
Case Is = vbCancel 
'Set up procedure to cancel close
Cancel = True 
End Select 
End If 
 
'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then 
.Saved = True 
Application.EnableEvents = True 
.Close savechanges:=False 
Else 
Application.EnableEvents = True 
End If 
End With 
End Sub 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
'Turn off events to prevent unwanted loops
Application.EnableEvents = False 
 
'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI) 
Cancel = True 
 
'Turn events back on an set saved property to true
Application.EnableEvents = True 
ThisWorkbook.Saved = True 
End Sub 
 
Private Sub Workbook_Open() 
'Unhide all worksheets
Application.ScreenUpdating = False 
Call ShowAllSheets 
Application.ScreenUpdating = True 
End Sub 
 
Private Sub CustomSave(Optional SaveAs As Boolean) 
Dim ws As Worksheet, aWs As Worksheet, newFname As String 
'Turn off screen flashing
Application.ScreenUpdating = False 
 
'Record active worksheet
Set aWs = ActiveSheet 
 
'Hide all sheets
Call HideAllSheets 
 
'Save workbook directly or prompt for saveas filename
If SaveAs = True Then 
newFname = Application.GetSaveAsFilename( _ 
fileFilter:="Excel Files (*.xls), *.xls") 
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname 
Else 
ThisWorkbook.Save 
End If 
 
'Restore file to where user was
Call ShowAllSheets 
aWs.Activate 
 
'Restore screen updates
Application.ScreenUpdating = True 
End Sub 
 
Private Sub HideAllSheets() 
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet 
 
Worksheets(WelcomePage).Visible = xlSheetVisible 
 
For Each ws In ThisWorkbook.Worksheets 
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden 
Next ws 
 
Worksheets(WelcomePage).Activate 
End Sub 
 
Private Sub ShowAllSheets() 
'Show all worksheets except the macro welcome page
 
Dim ws As Worksheet 
 
For Each ws In ThisWorkbook.Worksheets 
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible 
Next ws 
 
Worksheets(WelcomePage).Visible = xlSheetVeryHidden 
End Sub
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"Cannot copy or ''drag & drop''.", 16, "For this workbook:"
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Application.CutCopyMode = False
End Sub
Dim MyDataObject As New DataObject
Dim OldTarget As Range
Dim MyDataObject As New DataObject
Dim OldTarget As Range
Private Sub CommandButton1_Click()
Range("A1").Copy
Range("A2").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End Sub

I have the following in Module 1:
Code: 
Sub CtrlC()
MsgBox "Sorry! The shortcut 'Ctrl+C' has been disabled. ", , "Disabled Shortcut"
End Sub
Sub CtrlX()
MsgBox "Sorry! The shortcut 'Ctrl+X' has been disabled. ", , "Disabled Shortcut"
End Sub
Sub CtrlV()
MsgBox "Sorry! The shortcut 'Ctrl+V' has been disabled. ", , "Disabled Shortcut"
End Sub

In testing the workbook, I found users could still access the paste option from the ribbon if they did not first select either copy or cut from the ribbon first.

I found an article outlining use of the UI EDitor to disable buttons from the ribbon.

I now have the following in the UI Editor:

<?XML:NAMESPACE PREFIX = [default] http://schemas.microsoft.com/office/2009/07/customui NS = "http://schemas.microsoft.com/office/2009/07/customui" /><customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"><commands><customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> <commands >
<command idMso ="Copy"enabled ="false"/>
<command idMso ="Cut"enabled ="false"/>
<command idMso ="Paste"enabled ="false"/>
commands> customUI>



Combined, this seems to have locked the workbook down as much as possible, however, I am ow having problems saving the workbook as anything except an Excel file.

Do you think it is due to the following code:
Code: 
'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If
Thank you!

</commands></customUI>
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Re-enabling Copy, Cut, Paste, Drag/Drop Cells in Excel
Replies
5
Views
852
Peter_SSs
Peter_SSs
L
  • Question
VBA to autosave and close after a set amount of time
Replies
3
Views
281
Anthony47
A
D
  • Solved
Creating Message Boxes
Replies
4
Views
221
davidzan
D
P
  • Question
Data not copying fully into ListBox2
Replies
0
Views
186
Patriot2879
P
E
  • Question
Msg Box Doesn't Appear - VBA Code
Replies
1
Views
332
Micron
M

Forum statistics

Threads
1,216,723
Messages
6,132,319
Members
449,718
Latest member
Marie42719

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