用 VBA 阻止用户在 Excel 表中粘贴数据(续2)
- 2026-11-08 03:38:35
用 VBA 阻止用户在 Excel 表中粘贴数据(续2)上篇用 VBA 阻止用户在 Excel 表中粘贴数据(续)中保存工作薄后执行的命令 不支持 Excel 2007,需要 Excel 2010 及以后版本才可以。工厂生产现场用的就是这么旧的版本,想升级?这可是不以我的意志为转移的,所以只能想别的办法了: 之前的程序是阻止了所有的数据粘贴操作,在实际使用中发现有些地方又需要允许用户粘贴,只需要限制工作表中部分列的粘贴操作。比如下面这个表,只需要限制黄色的区域列,也就是记录测量值的部分,其它区域要允许粘贴。 
实现方法:修改 ThisWorkbook 中选择变更事件代码 插入一个标准模块,添加计算剪贴板数据列数的自定义函数 至此,大功告成!
'保存工作薄后执行Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'关闭工作簿前执行Private Sub Workbook_BeforeClose(Cancel As Boolean)Call 全加锁End Sub

'变更选择时执行Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)On Error Resume Next '忽略错误Dim firstCol As Long, lastCol As LongDim colCount As Long' 计算列范围firstCol = Target.ColumncolCount = 剪贴板列数()lastCol = firstCol + colCount - 1' 简化逻辑:直接判断选区是否与保护列范围(8-23列)有重叠If (firstCol <= 23 And lastCol >= 8) ThenApplication.CutCopyMode = False ' 自动清除剪贴板' MsgBox "禁止复制数据"End If
Function 剪贴板列数() As LongDim clipboardData As StringDim lines() As StringDim firstLine As StringDim columns() As String' 获取剪贴板文本内容clipboardData = CreateObject("htmlfile").ParentWindow.clipboardData.GetData("text")If Len(clipboardData) = 0 Then剪贴板列数 = 0Exit FunctionEnd If' 按换行符分割成行lines = Split(clipboardData, vbNewLine)If UBound(lines) >= 0 ThenfirstLine = lines(0)' 按制表符分割第一行(Excel默认使用制表符分隔)columns = Split(firstLine, vbTab)剪贴板列数 = UBound(columns) + 1Else剪贴板列数 = 0End IfEnd Function

本文来自网友投稿或网络内容,如有侵犯您的权益请联系我们删除,联系邮箱:wyl860211@qq.com 。