Option Explicit
Private WithEvents CmndBars As CommandBars
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL] VBA7 Then
Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
Private lCBrdSequenceNumber As Long
Private Const TAREGT_RANGE = "Sheet1!A1:A10" [B][COLOR=#008000]' <=== Change Target Range as required.[/COLOR][/B]
Private Sub Workbook_Open()
lCBrdSequenceNumber = GetClipboardSequenceNumber
Set CmndBars = Application.CommandBars
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
lCBrdSequenceNumber = GetClipboardSequenceNumber
Set CmndBars = Application.CommandBars
End Sub
Private Sub CmndBars_OnUpdate()
[B][COLOR=#008000]'Prevent copying any cell within range: "Sheet1!A1:A10" !![/COLOR][/B]
With Application
If Not Intersect(.ActiveWindow.RangeSelection, Range(TAREGT_RANGE)) Is Nothing Then
If .CutCopyMode Then
If lCBrdSequenceNumber <> GetClipboardSequenceNumber Then
.CutCopyMode = 0
MsgBox "You can't Cut or Copy any cell within the range :" & vbCr _
& TAREGT_RANGE, vbCritical
End If
End If
End If
End With
lCBrdSequenceNumber = GetClipboardSequenceNumber
End Sub
Thanks!
How do I disable Cell Drag N Drop functionality?
Yes, works fine! Thanks a lot.
So simple. I saw much complex codes elsewhere in google that I even wanted to try
It's possible to disable copy as image also?
Thanks
Option Explicit
Private WithEvents CmndBars As CommandBars
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL] VBA7 Then
Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
Private lCBrdSequenceNumber As Long
Private Const TAREGT_RANGE = "Sheet1!A1:A10" [B][COLOR=#008000]' <=== Change Target Range as required.[/COLOR][/B]
Private Sub Workbook_Open()
lCBrdSequenceNumber = GetClipboardSequenceNumber
Set CmndBars = Application.CommandBars
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
lCBrdSequenceNumber = GetClipboardSequenceNumber
Set CmndBars = Application.CommandBars
End Sub
Private Sub CmndBars_OnUpdate()
[B][COLOR=#008000] 'Prevent copying and Dragging any cell within the range: "Sheet1!A1:A10" !![/COLOR][/B]
With Application
If ActiveSheet Is .Range(TAREGT_RANGE).Parent Then
If Not Intersect(.ActiveWindow.RangeSelection, .Range(TAREGT_RANGE)) Is Nothing Then
If .CellDragAndDrop Then OpenClipboard 0: .CellDragAndDrop = False: CloseClipboard
If lCBrdSequenceNumber <> GetClipboardSequenceNumber Then
OpenClipboard 0
EmptyClipboard
CloseClipboard
MsgBox "You can't Cut or Copy any cell within the range :" & vbCr _
& TAREGT_RANGE, vbCritical
End If
Else
If .CellDragAndDrop = False Then .CellDragAndDrop = True
End If
Else
If .CellDragAndDrop = False Then .CellDragAndDrop = True
End If
End With
lCBrdSequenceNumber = GetClipboardSequenceNumber
End Sub