excel如何避免因补充破坏数据有效性

excel如何避免因补充破坏数据有效性

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 代码：

< 命令>

< 命令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

标准模块代码的图片版本如下：

clsCommandBarCatcher 的类模块代码的图片版本：

ThisWorkbook 模块的代码图片版本：

版权声明：本文内容由网络用户投稿，版权归原作者所有，本站不拥有其著作权，亦不承担相应法律责任。如果您发现本站中有涉嫌抄袭或描述失实的内容，请联系我们jiasou666@gmail.com 处理，核实后本网站将在24小时内删除侵权内容。