Excel 數據有效性（在 Excel 2013 及以上版本中改稱數據驗證）是一項很方便的功能，幫助我們讓用戶在單元格中輸入指定的數據。然而，將數據復制粘貼到設置了數據有效的單元格時，會破壞掉數據有效設置。
利用 VBA 代碼，可以避免因粘貼數據而破壞單元格數據有效設置。我原來的思路是，如果是有數據有效設置的單元格，在用戶粘貼數據前，我保存數據有效設置，在用戶但一直沒有著手編寫代碼，今天在jkp-ads.com 中看到實現這樣功能的代碼，偷個懶，稍稍作整理和修改，輯錄于此，供有需要的朋友參考。
要想避免粘貼操作帶來的影響，首先要捕獲所有可以采用的粘貼操作命令，有很多粘貼命令，包括：
1.Ctrl + V 組合鍵
2.Ctrl +插入組合鍵
3.Shift +插入組合鍵
4.輸入鍵
5. 功能區，菜單等位置的命令
下面是捕獲粘貼操作并指定相應處理的代碼。
在 VBE 中，插入一個稱為 clsCommandBarCatcher 的類模塊，輸入代碼：
‘ 捕獲命令預設的預設以阻止粘貼
公共WithEvents oComBarCtl作為Office.CommandBarButton
私人子Class_Terminate（）
設置oComBarCtl = Nothing
結束子
私人Sub oComBarCtl_Click（_
ByVal Ctrl作為Office.CommandBarButton，_
cancelDefault為Boolean）
cancelDefault = True
Application.OnTime現在，“ MyPasteValues”
結束子
插入一個標準模塊，輸入代碼：
選件專用模塊
“ 禁用復制粘貼
昏暗的mcCatchers作為收藏
‘ 確保將所有的復制操作重定向到自已的操作
‘ 視網膜覆蓋掉樣式和有效性驗證
子CatchPaste（）
StopCatchPaste
設置mcCatchers =新收藏
‘ 粘貼按鈕
AddCatch“虛擬”，22
‘ 粘貼（帶拖動）
EnableDisableControl 6002，否
‘ 選擇性粘貼按鈕
AddCatch“虛擬”，755
‘ 粘貼鏈接按鈕
AddCatch“虛擬”，2787年
‘ 粘貼格式按鈕
AddCatch“虛擬”，369
‘ 插入剪切單元格按鈕
AddCatch“虛擬”，3185
‘ 插入復制單元格按鈕
AddCatch“虛擬”，3187
‘Ctrl + V
Application.OnKey“ ^ v”，“ MyPasteValues”
‘Ctrl +插入
Application.OnKey“ ^ {Insert}”，“ MyPasteValues”
‘Shift +插入
Application.OnKey“ + {Insert}”，“ MyPasteValues”
‘輸入
Application.OnKey“?”，“ MyPasteValues”
Application.OnKey“ {Enter}”，“ MyPasteValues”
‘ 修改單元格折射率模式
如果是Application.CellDragAndDrop然后
Application.CellDragAndDrop =假
萬一
結束子
‘ 重置粘貼操作為重置值
子StopCatchPaste（）
盡可能暗淡
關于錯誤繼續
設置mcCatchers = Nothing
EnableDisableControl 6002，真
Application.OnKey“ ^ v”
Application.OnKey“ ^ {插入}”
Application.OnKey“ + {插入}”
Application.OnKey“?”
Application.OnKey“ {Enter}”
‘Application.CellDragAndDrop = True
結束子
‘ 添加到監控的命令欄控件
Sub AddCatch（sCombarName為字符串，lID為長）
Dim oCtl作為CommandBarControl
昏暗的CCatcher作為clsCommandBarCatcher
Dim oBar作為CommandBar
設置oCtl =否
關于錯誤繼續
設置oBar = Application.CommandBars（sCombarName）
如果oBar什么都沒有，那么
設置oBar = Application.CommandBars.Add（sCombarName，，，True）
oBar.Controls.Add ID：= lID
oBar.Visible = True
萬一
帶oBar
設置oCtl = .FindControl（ID：= lID，遞歸：= True）
如果oCtl什么都沒有
設置oCtl = .Controls.Add（ID：= lID）
萬一
結束于
‘ 試圖通過單元格快捷菜單分別插入復制/ 剪切的單元格
如果oCtl是Nothing And（lID = 3185或lID = 3187），則
設置oCtl = Application.CommandBars（“ Cell”）。_
FindControl（ID：= lID，遞歸：= True）
萬一
設置CCatcher =新的clsCommandBarCatcher
設置CCatcher.oComBarCtl = oCtl
mcCatchers.Add CCatcher
設置CCatcher = Nothing
oBar.Delete
設置oBar = Nothing
結束子
‘ 開啟/ 替代所有命令預設的指定控件
Private Sub EnableDisableControl（ID長，bEnable為布爾值）
Dim oBar作為CommandBar
Dim oCtl作為CommandBarControl
關于錯誤繼續
對于CommandBars中的每個oBar
設置oCtl = oBar.FindControl（ID：= lID，遞歸：= True）
如果沒有，那么
oCtl.Enabled = b啟用
萬一
下一個
結束子
‘ 從clsCommandBarCatcher 的控件事件處理
‘ 和不同的OnKey 宏中調用專門的粘貼值程序
公共子MyPasteValues（）
如果Application.CutCopyMode <> False則
如果MsgBox（“ 正常的粘貼操作已被替換。你將粘貼值（不能恢復），是否繼續？” _
＆vbNewLine＆“ 提示：要想可以重新命名，使用命令替換的粘貼值按鈕。”，_
vbQuestion + vbOKCancel，“ 禁止標題演示”）= vbOK然后
關于錯誤ResumeNext
Selection.Paste特殊粘貼：= xlValues
IsCellValidationOK選擇
萬一
ElseIf Application.MoveAfterReturn然后
關于錯誤繼續
選擇案例應用程序.MoveAfterReturnDirection
案例xlUp
ActiveCell.Offset（-1）。選擇
案例xlDown
ActiveCell.Offset（1）。選擇
案例xlToRight
ActiveCell.Offset（，1）。選擇
案例xlToLeft
ActiveCell.Offset（，-1）。選擇
結束選擇
萬一
結束子
‘ 檢查要粘貼到的單元格有無違反數據驗證規則
‘ 如果違反任意單元格驗證則返回False
公共函數IsCellValidationOK（對象的oRange）為布爾值
Dim oCell作為范圍
如果TypeName（oRange）<>“ Range”然后退出函數
IsCellValidationOK = True
對于oRange中的每個oCell
如果NotoCell.Validation無效
如果oCell.HasFormula然后
其他
如果oCell.Validation.Value = False，則
IsCellValidationOK = False
退出
萬一
萬一
萬一
下一個
如果IsCellValidationOK = False，則
MsgBox“ 警告!!!” ＆vbNewLine＆vbNewLine＆_
“ 粘貼操作導致不合規法規出現在1 個或多個包含有效驗證規則的單元格中。” _
＆vbNewLine＆vbNewLine＆_
“ 請檢查剛才粘貼值的所有單元格并改正錯誤！”，_
vbOKOnly + vbExclamation，“ 禁止粘貼演示”
范圍選擇
萬一
結束功能
Public Sub MyPasteValues2007（控件為IRibbonControl，ByRefcancelDefault）
MyPasteValues
結束子
在工作簿 ThisWorkbook 代碼模塊，輸入代碼：
私有mdNextTimeCatchPaste作為Double
私人子Workbook_Activate（）
CatchPaste
結束子
私有子工作簿_BeforeClose（取消為布爾值）
StopCatchPaste
mdNextTimeCatchPaste =現在
Application.OnTimemdNextTimeCatchPaste，“’”和ThisWorkbook.Name和“’！CatchPaste”
Application.CellDragAndDrop = True
結束子
私人子Workbook_Deactivate（）
StopCatchPaste
關于錯誤繼續
Application.OnTimemdNextTimeCatchPaste，“’”和ThisWorkbook.Name＆“’！CatchPaste”，，False
結束子
私人子Workbook_Open（）
CatchPaste
結束子
在工作簿打開時，進行相應的設置。在工作簿關閉或非當前工作簿時，恢復相應的設置。
關閉該工作簿，并使用 CustomUI 編輯器打開該工作簿，輸入下面的 XML 代碼：
< customUI xmlns = “ http://schemas.microsoft.com/office/2006/01/customui ” >
< 命令>
< 命令idMso = “ 粘貼” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteSpecial ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteFormulas ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteFormatting ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteValues ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteNoBorders ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteTranspose ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteLink ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteSpecial ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteAsHyperlink ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PastePictureLink ” onAction = “ MyPasteValues2007 ” />
< 命令idMso = “ PasteAsPicture ” onAction = “ MyPasteValues2007 ” />
保存并關閉 CustomUI 編輯器。再打開工作簿，試試效果，如下圖 1 所示。
圖 1
標準模塊代碼的圖片版本如下：
