Content
Introduction
You know the situation: You have carefully setup a workbook with intricate
Validation schemes. But then along comes your user and he copies and pastes
at will. Result: Validation zapped, workbook structure violated.
What to do? The only way I find reliable is to catch all possible paste
operations. But this isn't very easy, since there are a zilion ways to paste:
- Control+v
- Control+Insert
- Shift + Insert
- Enter
- And of course various menu items and toolbar buttons, which may
be located anywhere.
This article shows one way to intercept all these paste operations.
Explanation Of Parts Of The Code
Catching Keyboard Shortcuts
The only way to catch paste keyboard shortcuts is by assigning them to
your own paste code. E.g. like this:
Application.OnKey "^v", "MyPasteValues"
Application.OnKey "^{Insert}", "MyPasteValues"
Application.OnKey "+{Insert}", "MyPasteValues"
Application.OnKey "~", "MyPasteValues"
Application.OnKey "{Enter}", "MyPasteValues"
(the MyPasteValues routine is shown further below)
Catching Clicks On Toolbar And Menu Controls
To catch clicks on Commandbar controls, I used a class module in which
a variable is declared of type commandbarcontrol, using the WithEvents keyword.
Then an instance of this class module is created for each control I want
to intercept.
The class (named clsCommandBarCatcher), contains this code:
'-------------------------------------------------------------------------
' Module : clsCommandBarCatcher
' Company : JKP Application Development
Services (c)
' Author : Jan Karel Pieterse
' Created : 4-10-2007
' Purpose : This class catches clicks
on Excel's commandbars to be able to prevent pasting.
'-------------------------------------------------------------------------
Option Explicit
Public WithEvents
oComBarCtl As Office.CommandBarButton
Private Sub Class_Terminate()
Set oComBarCtl =
Nothing
End Sub
Private Sub oComBarCtl_Click(ByVal
Ctrl As Office.CommandBarButton, CancelDefault
As Boolean)
CancelDefault = True
Application.OnTime Now, "MyPasteValues"
End Sub
And the code to create an instance of this class could look like this:
Dim oCtl As
CommandBarButton
Dim CCatcher
As clsCommandBarCatcher
Set oCtl = Application.CommandBars("Cell").FindControl(ID:=3185,
recursive:=True)
Set CCatcher =
New clsCommandBarCatcher
Set CCatcher.oComBarCtl = oCtl
To keep the instances of the classes "alive" I create a (module) collection
variable and add each instance to the collection.
The paste is handled by this routine:
Public Sub MyPasteValues()
'-------------------------------------------------------------------------
' Procedure : EnableDisableControl
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 24-9-2007
' Purpose : Propriatary paste values routine
called from control event
'
handler in clsCommandBarCatcher and from various OnKey macros.
'-------------------------------------------------------------------------
If Application.CutCopyMode <>
False Then
If MsgBox("Normal
paste operation has been disabled. You are about to Paste Values (cannot
be undone), proceed?" & vbNewLine & "Tip: to be able to undo
a paste, use the paste values button on the toolbar.", vbQuestion +
vbOKCancel, GSAPPNAME) = vbOK Then
On
Error Resume
Next
Selection.PasteSpecial
Paste:=xlValues
IsCellValidationOK
Selection
End
If
ElseIf Application.MoveAfterReturn
Then
On
Error Resume
Next
Select
Case Application.MoveAfterReturnDirection
Case xlUp
ActiveCell.Offset(-1).Select
Case xlDown
ActiveCell.Offset(1).Select
Case xlToRight
ActiveCell.Offset(,
1).Select
Case xlToLeft
ActiveCell.Offset(,
-1).Select
End Select
End If
End Sub
Note that the code above also mimicks the MoveAfterReturn behaviour of
Excel.
Catching clicks on the Excel Ribbon (2007 and up)
To catch clicks on the various Excel 2007 (and up) paste controls, you
have to include CustomUI with your Excel 2007-2021, 365 format xlsm file.
The relevant Ribbon XML code is listed here:
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<commands>
<command idMso="Paste" onAction="MyPasteValues2007"/>
<command idMso="PasteSpecial" onAction="MyPasteValues2007"/>
<command idMso="PasteFormulas" onAction="MyPasteValues2007"/>
<command idMso="PasteFormatting" onAction="MyPasteValues2007"/>
<command idMso="PasteValues" onAction="MyPasteValues2007"/>
<command idMso="PasteNoBorders" onAction="MyPasteValues2007"/>
<command idMso="PasteTranspose" onAction="MyPasteValues2007"/>
<command idMso="PasteLink" onAction="MyPasteValues2007"/>
<command idMso="PasteSpecial" onAction="MyPasteValues2007"/>
<command idMso="PasteAsHyperlink"
onAction="MyPasteValues2007"/>
<command idMso="PastePictureLink"
onAction="MyPasteValues2007"/>
<command idMso="PasteAsPicture" onAction="MyPasteValues2007"/>
</commands>
</customUI>
This page
by Ron de Bruin clearly explains how to add ribbon customisations to your
files
Cell Drag And Drop Mode
Dragging the fill handle is another way to wreck your validation. Hence
this is turned off too. Unfortunately changing this setting empties the
clipboard, so this setting cannot be toggled at will when switching workbooks.
If you do turn it on and off when switching to and from your workbook, copying
and pasting from another workbook to the one with the code becomes impossible.
Validation
The code I showed above redirects all paste operations to one routine,
which does a paste special, values. But pasting does not trigger any validation
checks. Also, there is no way of knowing what cells may be affected by the
paste before the actual paste has been done. Luckily, after the paste, the
Selection object is equal to the cells affected by the paste. Using the
"Validation" object of the Range object it is possible to check whether
the cells adhere to their validation settings. I created this function,
to which I pass the range that has been changed. The function returns False
as soon as any cell violates its validation rule:
Public Function
IsCellValidationOK(oRange As
Object) As
Boolean
'-------------------------------------------------------------------------
' Procedure : ValidateCells
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 21-11-2007
' Purpose : This routine checks if entries
pasted into the cells in oRange
'
are not violating a validation rule.
'
Returns False if any cell's validation is violated
'-------------------------------------------------------------------------
Dim oCell As
Range
If TypeName(oRange) <> "Range"
Then Exit
Function
IsCellValidationOK = True
For Each
oCell In oRange
If
Not oCell.Validation Is
Nothing Then
If
oCell.HasFormula Then
Else
If
oCell.Validation.Value = False
Then
IsCellValidationOK
= False
Exit
For
End
If
End
If
End
If
Next
If IsCellValidationOK =
False Then
MsgBox "Warning!!!" & vbNewLine &
vbNewLine & _
"The paste
operation has caused illegal entries to appear" & vbNewLine &
_
"in one
or more cells containing validation rules." & vbNewLine & vbNewLine &
_
"Please
check all cells you have just pasted " & vbNewLine & _
"into and
correct any errors!", vbOKOnly + vbExclamation, GSAPPNAME
oRange.Select
End If
End Function
Switching On And Off
Of course I want this paste restriction to work on just the workbook
with the code. This means some code in the ThisWorkbook module is needed,
to be precise in the Workbook_DeActivate and Workbook_Activate events. This
is all code I have in ThisWorkbook:
Option Explicit
'Holds time of scheduled ontime macro
'(Workbook_Before_Close and Workbook_Deactivate)
Private mdNextTimeCatchPaste
As Double
Private Sub Workbook_Activate()
CatchPaste
End Sub
Private Sub Workbook_BeforeClose(Cancel
As Boolean)
StopCatchPaste
mdNextTimeCatchPaste = Now
Application.OnTime mdNextTimeCatchPaste, "'" & ThisWorkbook.Name &
"'!CatchPaste"
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Deactivate()
StopCatchPaste
On Error
Resume Next
'Cancel scheduled macro's,
'because we might be closing the file
Application.OnTime mdNextTimeCatchPaste, "'" & ThisWorkbook.Name &
"'!CatchPaste", , False
End Sub
Private Sub Workbook_Open()
CatchPaste
End Sub
Putting It All Together
The entire module that handles the initialisation and processes the paste
operation looks like this:
'-------------------------------------------------------------------------
' Module : modHandlePaste
' Author : Jan Karel Pieterse
' Created : 24-9-2007
' Purpose : Module that ensures paste
and paste formats is disabled
'-------------------------------------------------------------------------
Option Explicit
Option Private
Module
Dim mcCatchers As
Collection
Sub CatchPaste()
'-------------------------------------------------------------------------
' Procedure : CatchPaste
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 24-9-2007
' Purpose : This routine ensures all paste
operations are redirected to our own.
'
This way we avoid overwriting styles and validations.
'-------------------------------------------------------------------------
StopCatchPaste
Set mcCatchers =
New Collection
'Paste button
AddCatch "Dummy", 22
'Paste button (with dropdown)
EnableDisableControl 6002, False
'Paste Special button
AddCatch "Dummy", 755
'Paste As Hyperlink button
AddCatch "Dummy", 2787
'Paste Formats bottun
AddCatch "Dummy", 369
'Insert Cut cells button
AddCatch "Dummy", 3185
'Insert Copied Cells button
AddCatch "Dummy", 3187
Application.OnKey "^v", "MyPasteValues"
Application.OnKey "^{Insert}", "MyPasteValues"
Application.OnKey "+{Insert}", "MyPasteValues"
Application.OnKey "~", "MyPasteValues"
Application.OnKey "{Enter}", "MyPasteValues"
'Changing the celldragdrop mode clears
the clipboard.
'This means if you switch from another
workbook back to this one, you would be unable to copy
'information and paste it into the template.
This is why we do not reinstate the
'celldragdropmode when switching away
from a B1 template and vice versa: switch it off
'when we return to a template.
If Application.CellDragAndDrop
Then
'If the user has
manually changed this mode to true, the clipboard WILL be emptied due
to the next line
Application.CellDragAndDrop =
False
End If
End Sub
Sub StopCatchPaste()
'-------------------------------------------------------------------------
' Procedure : StopCatchPaste
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 24-9-2007
' Purpose : Resets the paste operations
to their defaults
'-------------------------------------------------------------------------
Dim lCount
As Long
On Error
Resume Next
Set mcCatchers =
Nothing
EnableDisableControl 6002, True
Application.OnKey "^v"
Application.OnKey "^{Insert}"
Application.OnKey "+{Insert}"
Application.OnKey "~"
Application.OnKey "{Enter}"
'Changing the celldragdrop mode clears
the clipboard.
'This means if you switch from another
workbook back to this one, you would be unable to copy
'information and paste it into the template.
This is why we do not reinstate the
'celldragdropmode when switching away
from a B1 template and vice versa: switch it off
'when we return to a template.
'Next line disabled for this reason!!!
' Application.CellDragAndDrop
= True
End Sub
Sub AddCatch(sCombarName
As String, lID
As Long)
'-------------------------------------------------------------------------
' Procedure : AddCatch
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 24-9-2007
' Purpose : Adds a commandbarcontrol to
be monitored
'-------------------------------------------------------------------------
Dim oCtl As
CommandBarControl
Dim CCatcher
As clsCommandBarCatcher
Dim oBar As
CommandBar
Set oCtl =
Nothing
On Error
Resume Next
Set oBar = Application.CommandBars(sCombarName)
If oBar Is
Nothing Then
Set oBar
= Application.CommandBars.Add(sCombarName, , , True)
oBar.Controls.Add ID:=lID
oBar.Visible =
True
End If
With oBar
Set oCtl
= .FindControl(ID:=lID, recursive:=True)
If oCtl
Is Nothing
Then
Set
oCtl = .Controls.Add(ID:=lID)
End
If
End With
'Try Insert copied/cut cells separately
through the cells shortcut menu
If oCtl Is
Nothing And (lID = 3185
Or lID = 3187) Then
Set oCtl
= Application.CommandBars("Cell").FindControl(ID:=lID, recursive:=True)
End If
Set CCatcher =
New clsCommandBarCatcher
Set CCatcher.oComBarCtl = oCtl
mcCatchers.Add CCatcher
Set CCatcher =
Nothing
oBar.Delete
Set oBar =
Nothing
End Sub
Private Sub EnableDisableControl(lID
As Long, bEnable
As Boolean)
'-------------------------------------------------------------------------
' Procedure : EnableDisableControl
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 24-9-2007
' Purpose : Enables or disables a specific
control on all commandbars
'-------------------------------------------------------------------------
Dim oBar As
CommandBar
Dim oCtl As
CommandBarControl
On Error
Resume Next
For Each
oBar In CommandBars
Set oCtl
= oBar.FindControl(ID:=lID, recursive:=True)
If
Not oCtl Is
Nothing Then
oCtl.Enabled
= bEnable
End
If
Next
End Sub
Public Sub MyPasteValues()
'-------------------------------------------------------------------------
' Procedure : EnableDisableControl
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 24-9-2007
' Purpose : Propriatary paste values routine
called from control event
'
handler in clsCommandBarCatcher and from various OnKey macros.
'-------------------------------------------------------------------------
If Application.CutCopyMode <>
False Then
If MsgBox("Normal
paste operation has been disabled. You are about to Paste Values (cannot
be undone), proceed?" & vbNewLine & "Tip: to be able to undo
a paste, use the paste values button on the toolbar.", vbQuestion +
vbOKCancel, GSAPPNAME) = vbOK Then
On
Error Resume
Next
Selection.PasteSpecial
Paste:=xlValues
IsCellValidationOK
Selection
End
If
ElseIf Application.MoveAfterReturn
Then
On
Error Resume
Next
Select
Case Application.MoveAfterReturnDirection
Case xlUp
ActiveCell.Offset(-1).Select
Case xlDown
ActiveCell.Offset(1).Select
Case xlToRight
ActiveCell.Offset(,
1).Select
Case xlToLeft
ActiveCell.Offset(,
-1).Select
End Select
End If
End Sub
Public Function
IsCellValidationOK(oRange As
Object) As
Boolean
'-------------------------------------------------------------------------
' Procedure : ValidateCells
' Author : Jan Karel Pieterse
jkp-ads.com
' Created : 21-11-2007
' Purpose : This routine checks if entries
pasted into the cells in oRange
'
are not violating a validation rule.
'
Returns False if any cell's validation is violated
'-------------------------------------------------------------------------
Dim oCell As
Range
If TypeName(oRange) <> "Range"
Then Exit
Function
IsCellValidationOK = True
For Each
oCell In oRange
If
Not oCell.Validation Is
Nothing Then
If
oCell.HasFormula Then
Else
If
oCell.Validation.Value = False
Then
IsCellValidationOK
= False
Exit
For
End
If
End
If
End
If
Next
If IsCellValidationOK =
False Then
MsgBox "Warning!!!" & vbNewLine &
vbNewLine & _
"The paste
operation has caused illegal entries to appear" & vbNewLine &
_
"in one
or more cells containing validation rules." & vbNewLine & vbNewLine &
_
"Please
check all cells you have just pasted " & vbNewLine & _
"into and
correct any errors!", vbOKOnly + vbExclamation, GSAPPNAME
oRange.Select
End If
End Function
Sample File
I prepared a sample file so
you can see how to put this all together. The download contains two workbooks;
one for Excel 2003 and earlier, the other for Excel 2007 and up.