ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > 我的酷贴 > Excel VBA > 定时保护锁定工作表单元格

定时保护锁定工作表单元格

作者：绿色风 分类： 时间：2022-08-18 浏览：79
楼主
水星钓鱼		 说实在的，我所在的部门用Excel的机会比较少，顶多是用来存储些客户的信息。由于天天接触的企业众多，因此有必要及时的记录企业的联络方式。因此表头为企业简称、联系人、联系方式、传真。因为键盘是放在桌面上的，当业务量多时，很多样品堆积于桌面，放在键盘上，一不小心就把已经录好的联系人的信息给误删了。为此，我想通过VBA来实现，及时的保护工作表。因为记录企业信息的时候肯定是一个单元格一个单元格地录，所以必须在录完一个单元格后即保护工作表。而未录的单元格又不受影响，可以继续录入。还有一种情况是经常要在已经录好的名目中补充或删减信息，这时候要用到插入和删除单元格操作。而这两项操作又会同时触发Worksheet_change事件。综合考虑和调试，步骤如下：
1.首先将空白工作表的所有单元格的锁定属性设置为无
2.设置该工作表的VBA代码如下：
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim Cell As Range
  3.     ActiveSheet.Unprotect
  4.     For Each Cell In Target
  5.         If Cell <> "" Then
  6.             With Cell
  7.                 .Locked = True
  8.                 .Borders.LineStyle = xlContinuous
  9.             End With
  10.         Else
  11.             Cell.Locked = False
  12.         End If
  13.     Next
  14.     ActiveSheet.Protect
  15. End Sub

请看6楼的完美解决方案。
2楼
gouweicao78		 谢谢分享！


对于这种情况如何处理？即录入完后要修改或删除，会比较麻烦。

我用笔记本好些年了，一般不会有东西压到键盘造成破坏数据的问题，但有个问题，即人在的时候，就是有东西在桌面上，一般也不会去碰让它压在键盘上。因此，主要的问题就变成——人不在的时候。

我的另一个习惯，设置Windows登陆密码（只需简单的、方便操作的密码，因为这个并不安全，弄个U盘下载个软件就可以破解），然后在离开电脑的时候，按一下<Win+L>组合键，这样，一般人不易进入我电脑查看，有东西压到键盘的话也没事儿，呵呵。
3楼
水星钓鱼		 对于录错了要修改确实比较麻烦，我只好暂时用如下办法解决，通过鼠标右键来取消保护。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim Cell As Range
  3.     ActiveSheet.Unprotect
  4.     For Each Cell In Target
  5.         If Cell <> "" Then
  6.             With Cell
  7.                 .Locked = True
  8.                 .Borders.LineStyle = xlContinuous
  9.             End With
  10.         Else
  11.             Cell.Locked = False
  12.         End If
  13.     Next
  14.     ActiveSheet.Protect
  15. End Sub
  1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  2.     ActiveSheet.Unprotect
  3. End Sub
4楼
dja621		 这个方式好，但修改很麻烦，是否可以修改为双击单元格，自动放弃保护，设置为几分钟后，不修改又自动保护，修改就立即保护，怎么样？我在等你修改哈。谢谢

5楼
hlxz		 首先肯定 水星钓鱼 这是个好文章

以下回复4楼：
'1.首先将空白工作表的所有单元格的锁定属性设置为无
'2.如果A1值是 "保护" 那么输入一个保护一个,注意有值的单元格都会保护
'3.如果A1值是 "修改" 那么输入一个所有单元格都可以修改 不再保护，如需保护，请A1中输入"保护"
'4.功能：有条件的及时条件保护单元格
'5.作者：欢乐小爪
'6.修改水星钓鱼的代码 引用excelba的bengdeng的自定义函数,并感谢 水星钓鱼 bengdeng
'7.设置该工作表的VBA代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell
ActiveSheet.Unprotect
'撤消工作表保护，以便设置单元格的锁定属性
On Error GoTo 100
If Target <> "" Then
For Each cell In GetCellTypeNotBlanks(Application.Union(ActiveSheet.Range("B1:IV1"), ActiveSheet.Range("A2:IV65536")))
If Range("A1") = "保护" Then
cell.Locked = True
cell.Borders.LineStyle = xlContinuous '
ElseIf Range("A1") = "修改" Then
Cells.Locked = False
Cells.Borders.LineStyle = xlNone
ActiveSheet.Unprotect
GoTo 100
End If
Next
End If
ActiveSheet.Protect
100:
End Sub
Function GetCellTypeNotBlanks(Target As Range) As Range
'*******************************************
'作者：bengdeng
'功能：获得指定单元格区域中的所有非空单元格
'发布：
'*******************************************
Dim TRan As Range, RRan As Range
On Error Resume Next
Set TRan = Target.Parent.UsedRange.Item(ActiveSheet.UsedRange.Count).Offset(1, 0)
Set RRan = Union(TRan, Target)
Set GetCellTypeNotBlanks = RRan.ColumnDifferences(TRan)
End Function

源文件 《及时条件锁定保护单元格不被修改》
http://hi.baidu.com/huanhuanxiaozhua/blog/item/d
6楼
水星钓鱼
谢谢你提的建议，我认真的考虑了你的建议。首先用双击来取消保护是不好的，它会与单元格的Change事件矛盾。所以我改成用单击鼠标右键来取消保护，现在代码修改后可以实现，修改任意一个单元格后10秒内如果没有其它操作，即保护单元格。如果继续修改，则重新计时。请多指教。

  2. '定义一个模块级的变量TimeVar
  3. '用来指定要在何时保护工作表
  4. Private TimeVar As Date
  5. '定义一个模块级的变量CountNum
  6. '用来记录Change事件发生的次数
  7. Private CountNum As Long
  8. 'BeforeRightClick事件使单击鼠标
  9. '右键就解除工作表的保护
  10. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  11.     ActiveSheet.Unprotect
  12. End Sub
  13. Private Sub Worksheet_Change(ByVal Target As Range)
  14.     On Error Resume Next
  15.     Dim Cell As Range
  16.     'Change事件发生时首先要撤销工作表的保护
  17.     '因为在保护工作表的情况下不能设置单元格的
  18.     'Locked属性
  19.     ActiveSheet.Unprotect
  20.     For Each Cell In Target
  21.         If Cell <> "" Then
  22.             Cell.Locked = True
  23.         Else
  24.            Cell.Locked = False
  25.         End If
  26.     Next
  27.     '第一次触发Change事件时,设定在10秒后
  28.     '保护工作表
  29.     If CountNum = 0 Then
  30.         TimeVar = Now + TimeValue("00:00:10")
  31.         Application.OnTime TimeVar, "Sheet1.ProtectAction"
  32.     Else
  33.         '假如在10秒内又触发了Change事件,则取消先前的定时任务.
  34.         '假如在10秒内没有任何操作,(即工作表保护了),则这句代码将
  35.         '出错,此时On Error Resume Next 将忽略错误,继续执行
  36.         '下一句代码
  37.         Application.OnTime TimeVar, "Sheet1.ProtectAction", , Fasle
  38.         '重新计时，在此时的10秒后再执行保护工作表
  39.         TimeVar = Now + TimeValue("00:00:10")
  40.         Application.OnTime TimeVar, "Sheet1.ProtectAction"
  41.     End If
  42.         CountNum = CountNum + 1
  43. End Sub


定时保护工作表.rar
7楼
freelegend		 学到不少,希望自己也从中有所领悟.
8楼
ljx63426		 学到不少东东
9楼
qinhuan66		 好好学习天天向上
10楼
opelwang		 通过测试6楼的代码，实现效果如下。
1、在录入前将一张空白表的单元格锁定属性取消，然后再输入数据。
2、输入过程中，间断10秒，本表内无任何操作，自动保护工作表；
3、鼠标右键可以即时解锁，重复第2步。

总之来说，效果不错。学习了。
11楼
冥古宙		 高手。谢谢！学习中
12楼
mankason		 版主定时过了能不能只用密码才能打开，VBA要怎么改，先谢了

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap