Forum

VBA disable Copy Cu...
 
Notifications
Clear all

VBA disable Copy Cut and paste for important data

8 Posts
2 Users
0 Reactions
451 Views
(@david_ng)
Posts: 310
Reputable Member
Topic starter
 

How to disable copy and cut function using vba.

 
Posted : 31/10/2020 4:41 am
(@rhysand)
Posts: 80
Trusted Member
 

Hello,

Do you want to disable it for the sheet or for a control (example: textbox) in the userform?

Example for a textbox in a userform:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

' prohibit use of keyboard keys
If KeyCode = 86 And Shift = 2 Then
     KeyCode = 0
     MsgBox "Access denied:" & vbCrLf & vbCrLf & "• It is prohibited to use data paste function (Ctrl+V)...", vbCritical, "Option denied!"
End If

If KeyCode = 67 And Shift = 2 Then
     KeyCode = 0
     MsgBox "Access denied:" & vbCrLf & vbCrLf & "• It is prohibited to use data function (Ctrl+C)...", vbCritical, "Option denied!"
End If

If KeyCode = 88 And Shift = 2 Then
     KeyCode = 0
     MsgBox "Access denied:" & vbCrLf & vbCrLf & "• It is prohibited to use data cut function (Ctrl+X)...", vbCritical, "Option denied!"
End If
'---------------------------------------------
'COD:
'Shift = 1 : key (SHIFT)
'Shift = 2 : key (CTRL)
'Shift = 4 : key (ALT)
'Shift = 3 : key (CTRL+SHIFT)
'---------------------------------------------

End Sub

 

Example for the sheet (for paste):
Private Sub Worksheet_Change(ByVal target As Range)

Dim rightClick As String

rightClick = Application.CommandBars("Standard").FindControl(ID:=128).List(1)

Select Case rightClick
     Case "Paste", "Paste Special"
          MsgBox "option disabled!", vbExclamation, "Information!"
     Case Else
          '  do nothing
End Select

End Sub

 

Example for the Workbook (for cut copy mode):

Private Sub Workbook_Activate() ' Disable all Copy menus

Dim appCtrl As Office.CommandBarControl

For Each appCtrl In Application.CommandBars.FindControls(ID:=21)
    appCtrl.Enabled = False
Next appCtrl

For Each appCtrl In Application.CommandBars.FindControls(ID:=19)
    appCtrl.Enabled = False
Next appCtrl

Application.CellDragAndDrop = False

End Sub

Private Sub Workbook_Deactivate() 'Enable all Cut menus

Dim appCtrl As Office.CommandBarControl

For Each appCtrl In Application.CommandBars.FindControls(ID:=21)
    appCtrl.Enabled = True
Next appCtrl

For Each appCtrl In Application.CommandBars.FindControls(ID:=19)
    appCtrl.Enabled = True
Next appCtrl

Application.CellDragAndDrop = True

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

With Application
     .CellDragAndDrop = False
     .CutCopyMode = False
End With

End Sub

 

Regards,

Miguel

 
Posted : 01/11/2020 10:15 am
(@david_ng)
Posts: 310
Reputable Member
Topic starter
 

Thanks so much Miguel, will try on these  codes.

 
Posted : 02/11/2020 7:55 pm
(@david_ng)
Posts: 310
Reputable Member
Topic starter
 

Miguel, after run this  Macro vb now the right click mouse Copy & Paste or Drag and Drop , not working,[ Winodws 10 ]  in other Excel worksheet book,  please help how to restore..

 
Posted : 02/11/2020 11:09 pm
(@rhysand)
Posts: 80
Trusted Member
 

Hello,

his method as described, when the workbook with the code is opened, it cancels throughout the application, affecting all other workbooks, so you must have the code to cancel when and reset everything to normal, when workbook is closed. (it is very important to restore the situation)

when closing the workbook with the code, everything goes back to normal for any other workbook

 

Private Sub Workbook_Activate() ' Disable all Copy menus

Dim appCtrl As Office.CommandBarControl

For Each appCtrl In Application.CommandBars.FindControls(ID:=21)
    appCtrl.Enabled = False
Next appCtrl

For Each appCtrl In Application.CommandBars.FindControls(ID:=19)
    appCtrl.Enabled = False
Next appCtrl

Application.CellDragAndDrop = False

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean) 'Enable all Cut menus

Dim appCtrl As Office.CommandBarControl

For Each appCtrl In Application.CommandBars.FindControls(ID:=21)
    appCtrl.Enabled = True
Next appCtrl

For Each appCtrl In Application.CommandBars.FindControls(ID:=19)
    appCtrl.Enabled = True
Next appCtrl

Application.CellDragAndDrop = True

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

With Application
     .CellDragAndDrop = False
     .CutCopyMode = False
End With

End Sub

 

another example to prohibit deleting / inserting columns or rows in the excel sheet

the situation is the same, it will affect all open workbooks, so it is very important to cancel the situation when the workbook as the code is closed

 

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim xBarControl As CommandBarControl

For Each xBarControl In Application.CommandBars.FindControls(ID:=293) 'enable "Row" Delete
     xBarControl.Enabled = True
Next

For Each xBarControl In Application.CommandBars.FindControls(ID:=294) 'enable "Column" Delete
     xBarControl.Enabled = True
Next

For Each xBarControl In Application.CommandBars.FindControls(ID:=3183) 'enable "Row" and "Column" Insert
     xBarControl.Enabled = True
Next

End Sub

Private Sub Workbook_Open()

Dim xBarControl As CommandBarControl

For Each xBarControl In Application.CommandBars.FindControls(ID:=293) 'Disable "Row" Delete
     xBarControl.Enabled = False
Next

For Each xBarControl In Application.CommandBars.FindControls(ID:=294) 'Disable "Column" Delete
     xBarControl.Enabled = False
Next

For Each xBarControl In Application.CommandBars.FindControls(ID:=3183) 'Disable "Row" and "Column" Insert
     xBarControl.Enabled = False
Next

End Sub

 

Regards,

Miguel

 
Posted : 03/11/2020 11:24 am
(@david_ng)
Posts: 310
Reputable Member
Topic starter
 

Thanks so much Miguel the clear explanation.

 

BTW appreciate if you can store the codes to a workbook and upload to the Forum for reference, preferably with the steps how to resume all Excel normal functions

 
Posted : 03/11/2020 9:01 pm
(@rhysand)
Posts: 80
Trusted Member
 

Hello,

I attached two excel files with the codes to work perfectly, both when opening WorkBooks and when they are closed

Regards,

Miguel

 
Posted : 04/11/2020 8:58 am
(@david_ng)
Posts: 310
Reputable Member
Topic starter
 

Deep thanks Miguel, really appreciate your shared work.

 
Posted : 04/11/2020 8:11 pm
Share: