Silver
12-30-2015, 02:11 AM
Hello,
I'm not a coder, just search for my requirement ask questions and do minor tweaks if possible.
I got below code from a topic posted on this site only.
Link to the topic - http://www.vbaexpress.com/forum/showthread.php?19391-Solved-Disable-Cut-Copy-Paste-Macro-for-One-Column
What the code does is disable copy paste of data to a single column or range. What I can understand from below code is, the disable function is for Column A on sheet1 and Range G1:G20 on sheet2.
Code in This Workbook
Option Explicit
Private Sub Workbook_Activate()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
Call ChkSelection(ActiveSheet)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Re-enable the cut, copy & paste commands
Call ToggleCutCopyAndPaste(True)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Deactivate()
'Re-enable the cut, copy & paste commands
Call ToggleCutCopyAndPaste(True)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Open()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
Call ChkSelection(ActiveSheet)
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call ChkSelection(Sh)
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Toggle the cut, copy & paste commands on selected ranges
Call ChkSelection(Sh)
End Sub
Code in a Standard Module
Option Explicit
Public Function InRange(Range1 As Range, Range2 As Range) As Boolean
' Added function to check if Cell is In Range
' returns True if Range1 is within Range2'
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
Sub ChkSelection(ByVal Sh As Object)
'Added Primarily to have one place to set restrictions
'It also fixes the issue where a cell you don't want to
'copy/paste from/to is already selected, but you
'came from a sheet that wasn't protected.
Dim rng As Range
Set rng = Range(Selection.Address)
Select Case Sh.Name
Case Is = "Sheet1"
'Disable copy and paste for anything in column A
If InRange(rng, Columns("A")) Then
Call ToggleCutCopyAndPaste(False)
Else
Call ToggleCutCopyAndPaste(True)
End If
Case Is = "Sheet2"
'Disable copy and paste for anything in range G1 to G20
If InRange(rng, Range("G1:G20")) Then
Call ToggleCutCopyAndPaste(False)
Else
Call ToggleCutCopyAndPaste(True)
End If
Case Else
Call ToggleCutCopyAndPaste(True)
End Select
End Sub
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
'Drag and Drop Disabled from Original code due to deselecting what has been
'copied and not allowing paste. Moved to when workbook opens.
'Drag and drop will not be allowed for entire workbook.
'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 for the specified range."
End Sub
Problem with above code -
It does not allow to copy paste data from different workbooks to workbook where the macro is stored.
My requirement (Addition to above code) -
I want to disable copy paste function for Column A only on Sheet1.
Lets say macro is stored in WorkBook1 (WB1) and restriction is only for Column A in sheet1.
If data is copied from different workbooks to WB1, the code should allow to cut and copy
data from different workbooks, it should allow to paste data anywhere in WB1 expect for Column A in Sheet1. Paste special should also be restricted for Column A in Sheet1 only.
Above code has restriction for Range G1:G20 in sheet2. I want this to be removed from the code.
I have attached sample sheet with above code.
I request any one helping me out to provide the complete working code
I'm not a coder, just search for my requirement ask questions and do minor tweaks if possible.
I got below code from a topic posted on this site only.
Link to the topic - http://www.vbaexpress.com/forum/showthread.php?19391-Solved-Disable-Cut-Copy-Paste-Macro-for-One-Column
What the code does is disable copy paste of data to a single column or range. What I can understand from below code is, the disable function is for Column A on sheet1 and Range G1:G20 on sheet2.
Code in This Workbook
Option Explicit
Private Sub Workbook_Activate()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
Call ChkSelection(ActiveSheet)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Re-enable the cut, copy & paste commands
Call ToggleCutCopyAndPaste(True)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Deactivate()
'Re-enable the cut, copy & paste commands
Call ToggleCutCopyAndPaste(True)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Open()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
Call ChkSelection(ActiveSheet)
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call ChkSelection(Sh)
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Toggle the cut, copy & paste commands on selected ranges
Call ChkSelection(Sh)
End Sub
Code in a Standard Module
Option Explicit
Public Function InRange(Range1 As Range, Range2 As Range) As Boolean
' Added function to check if Cell is In Range
' returns True if Range1 is within Range2'
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
Sub ChkSelection(ByVal Sh As Object)
'Added Primarily to have one place to set restrictions
'It also fixes the issue where a cell you don't want to
'copy/paste from/to is already selected, but you
'came from a sheet that wasn't protected.
Dim rng As Range
Set rng = Range(Selection.Address)
Select Case Sh.Name
Case Is = "Sheet1"
'Disable copy and paste for anything in column A
If InRange(rng, Columns("A")) Then
Call ToggleCutCopyAndPaste(False)
Else
Call ToggleCutCopyAndPaste(True)
End If
Case Is = "Sheet2"
'Disable copy and paste for anything in range G1 to G20
If InRange(rng, Range("G1:G20")) Then
Call ToggleCutCopyAndPaste(False)
Else
Call ToggleCutCopyAndPaste(True)
End If
Case Else
Call ToggleCutCopyAndPaste(True)
End Select
End Sub
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
'Drag and Drop Disabled from Original code due to deselecting what has been
'copied and not allowing paste. Moved to when workbook opens.
'Drag and drop will not be allowed for entire workbook.
'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 for the specified range."
End Sub
Problem with above code -
It does not allow to copy paste data from different workbooks to workbook where the macro is stored.
My requirement (Addition to above code) -
I want to disable copy paste function for Column A only on Sheet1.
Lets say macro is stored in WorkBook1 (WB1) and restriction is only for Column A in sheet1.
If data is copied from different workbooks to WB1, the code should allow to cut and copy
data from different workbooks, it should allow to paste data anywhere in WB1 expect for Column A in Sheet1. Paste special should also be restricted for Column A in Sheet1 only.
Above code has restriction for Range G1:G20 in sheet2. I want this to be removed from the code.
I have attached sample sheet with above code.
I request any one helping me out to provide the complete working code