Apr 26 2019 03:32 PM
We have a workbook that has a lot of tables set up where users are supposed to enter data. These tables are ready by Power Query and/or VBA macros to do things with.
The problem is despite much education and wailing and gnashing of teeth, users refuse to consistently and reliabily use Paste|Values to prevent formatting, incorrect data types, or even creating formula links to other workbooks, which invariably causes Power Query or VBA code to fail. Even using Excel's Data Validation doesn't work because that ignores Paste operations, so you can paste text in to a formula only cell, etc.
This workbook already has VBA, so being a macro workbook is no problem.
I want to block paste. 100% of PASTE operations, and prefer to block CUT but I'm ok if CUT isn't blocked as no one yet has done that to cause an issue. I prefer that COPY remain intact as the results of this workbook are needed for other workbooks, emails, etc.
I've tried Ken Puls' solution here but in Excel for Office 365, which is around build 1905 right now, while CTRL-V is blocked, the Paste icons in the right-click menu and ribbon menu still work. Oddly enough, the COPY and CUT options are blocked, so something in Excel must have been changed since his post.
So I am currently using Tom Urtis' solution here which does work, but is absolutely draconian. His method is to disable the right-click menu entirely, but actually doesn't block CTRL-V, the nor the "menu key" on many keyboards today as long as the clipboard data originated from outside Excel. Data copied from other Excel workbooks will not paste, unless someone figures out they can launch a second copy of Excel, and they will.
So, any ideas?
Apr 26 2019 04:54 PM
Solution
To prevent Cut I use this
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, _ ByVal Target As Excel.Range) 'cancel cut mode Select Case Application.CutCopyMode Case Is = False 'do nothing Case Is = xlCopy 'do nothing Case Is = xlCut MsgBox "Please DO NOT Cut and Paste. Use Copy and Paste Special Values / Formula only.", vbCritical, "Cannot Use Cut & Paste" Application.CutCopyMode = False 'clear clipboard and cancel cut End Select End Sub
To prevent Paste and replace with Paste Values (avoids overwriting formatting etc) I use this
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) 'Routine to prevent normal/format paste and to replace with Paste Values/Formulas 'can also prevent copying from a non excel application or separate session of Excel Dim UndoString As String 'switch to ignore this code if in administrator mode If Range("swAdminMode").Value = "True" Then GoTo HandleExit End If Application.ScreenUpdating = False 'Undo all forms of Paste then re-paste values 'Relies on capturing the 1st item on the Undo list in the Undo menu On Error Resume Next ' required to deal with Undo list being empty UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1) 'reset error check to 0 incase error did occur err = 0 'if the action was not paste then this routine is exited If Left(UndoString, 5) <> "Paste" Then GoTo HandleExit End If 'Rule Application.ScreenUpdating = False Application.EnableEvents = False 'MsgBox "Will now convert to values" 'undo and convert to values Application.Undo On Error Resume Next '- needed to avoid erroring out if data copied from different "instance" of excel Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False 'check if Paste Special caused an error - most likely by trying to copy from wrong session of Excel If err <> 0 Then MsgBox "Are you trying to copy from a different session of Excel?" & Chr(13) & Chr(13) & _ "If so please close the file you are copying from " & Chr(13) & _ "and use the file open button on THIS session of Excel" & Chr(13) & _ "to open it and try again" & Chr(13) & Chr(13) & _ "The ability to copy from a non Excel application has been turned off." _ , vbOKOnly + vbQuestion, "Paste Failed" End If 'reset error err = 0 HandleExit: Application.ScreenUpdating = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub
I've had to take a few customisations out of the code above so hopefully haven't deleted anything critical
Apr 28 2019 06:14 AM
@Wyn Hopkins Thanks! Let me give this a shot.
Apr 28 2019 06:33 AM
Apr 28 2019 10:05 AM
Let's play Devil's advocate. If I were tasked with the boring task filling in someone's table or form, I would be pretty annoyed to find that the user interface had been crippled and techniques I knew for transferring data not longer worked. To the user, it is a case of 'if it looks right then it is right'.
The question then becomes 'Have you as a developer done everything you can to make your solution robust in the face of reasonable user action?' For example
Sub CleanLO()
Dim LO As ListObject
Set LO = ActiveSheet.ListObjects(1)
With LO.DataBodyRange
.ClearFormats
.Value = .Value
End With
End Sub
might clean up a number of 'user crimes'.
Apr 26 2019 04:54 PM
Solution
To prevent Cut I use this
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, _ ByVal Target As Excel.Range) 'cancel cut mode Select Case Application.CutCopyMode Case Is = False 'do nothing Case Is = xlCopy 'do nothing Case Is = xlCut MsgBox "Please DO NOT Cut and Paste. Use Copy and Paste Special Values / Formula only.", vbCritical, "Cannot Use Cut & Paste" Application.CutCopyMode = False 'clear clipboard and cancel cut End Select End Sub
To prevent Paste and replace with Paste Values (avoids overwriting formatting etc) I use this
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) 'Routine to prevent normal/format paste and to replace with Paste Values/Formulas 'can also prevent copying from a non excel application or separate session of Excel Dim UndoString As String 'switch to ignore this code if in administrator mode If Range("swAdminMode").Value = "True" Then GoTo HandleExit End If Application.ScreenUpdating = False 'Undo all forms of Paste then re-paste values 'Relies on capturing the 1st item on the Undo list in the Undo menu On Error Resume Next ' required to deal with Undo list being empty UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1) 'reset error check to 0 incase error did occur err = 0 'if the action was not paste then this routine is exited If Left(UndoString, 5) <> "Paste" Then GoTo HandleExit End If 'Rule Application.ScreenUpdating = False Application.EnableEvents = False 'MsgBox "Will now convert to values" 'undo and convert to values Application.Undo On Error Resume Next '- needed to avoid erroring out if data copied from different "instance" of excel Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False 'check if Paste Special caused an error - most likely by trying to copy from wrong session of Excel If err <> 0 Then MsgBox "Are you trying to copy from a different session of Excel?" & Chr(13) & Chr(13) & _ "If so please close the file you are copying from " & Chr(13) & _ "and use the file open button on THIS session of Excel" & Chr(13) & _ "to open it and try again" & Chr(13) & Chr(13) & _ "The ability to copy from a non Excel application has been turned off." _ , vbOKOnly + vbQuestion, "Paste Failed" End If 'reset error err = 0 HandleExit: Application.ScreenUpdating = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub
I've had to take a few customisations out of the code above so hopefully haven't deleted anything critical