[嘿嘿]工作簿禁止复制/粘贴/删除/双击

丰123

学习了

dahaocai

Sub auto_open()
    Dim Menu As CommandBarControl, SubMenu As CommandBarControl
    Set SubMenu = Application.CommandBars("tools").Controls.Add(msoControlPopup, 1, , 3, 1)
    SubMenu.Caption = "禁止复制与删除(&UnCopy)"
     With SubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "禁止复制与删除(&Computer)"
        .OnAction = "禁止"
        .Style = msoButtonIconAndCaption
        .FaceId = 225
      End With
'-----------------------------------------
      With SubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "恢复复制与删除(&Enable)"
        .OnAction = "恢复"
        .Style = msoButtonIconAndCaption
        .FaceId = 277
      End With
      With SubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "使用说明(&About)"
        .OnAction = "关于复制"
        .Style = msoButtonIconAndCaption
        .FaceId = 272
      End With
  End Sub
Sub auto_close()
Application.CommandBars("tools").Reset
End Sub
Sub EnableControl(iId As Integer, blnState As Boolean)
Dim ComBar As CommandBar
Dim ComBarCtrl As CommandBarControl
  On Error Resume Next
For Each ComBar In Application.CommandBars
    Set ComBarCtrl = ComBar.FindControl(ID:=iId, recursive:=True)
    If Not ComBarCtrl Is Nothing Then ComBarCtrl.Visible = blnState
Next
End Sub


Sub 恢复()
If Application.InputBox("请输入密码：", "权限验证", "不知道", Type:=1) <> 119 Then MsgBox "你没有操作权限": Exit Sub

Dim ComBar As CommandBar
Dim ComBarCtrl As CommandBarControl
    EnableControl 295, True  '// ..cells
    EnableControl 296, True  '// ..Rows
    EnableControl 297, True  '// ..Cols
    EnableControl 6002, True  '// ..Cols
    '// &Delete...
    EnableControl 478, True  '// &Delete...
    EnableControl 292, True  '// &Delete...
    EnableControl 293, True  '// ...Row
    EnableControl 294, True  '// ...Column
    EnableControl 847, True  '// RightClick Tab..
    '// Clear
    EnableControl 3125, True  '// Clear Contents
    EnableControl 1964, True  '// All
    EnableControl 872, True   '// Formats
    EnableControl 873, True   '// Contents
    EnableControl 874, True   '// Comments
    '// CutCopyPaste
    EnableControl 21, True    '// cut
    EnableControl 19, True    '// copy
    EnableControl 22, True    '// paste
    EnableControl 755, True   '// pastespecial
    EnableControl 809, True   '// pastespecial
Application.CommandBars("cell").Controls(4).Enabled = True
    '// ShortCut Keys
    With Application
        .OnKey "^c"
        .OnKey "^v"
        .OnKey "^x"
        .OnKey "+{DEL}"
        .OnKey "+{INSERT}"
        .OnKey "{del}"
        .CellDragAndDrop = True
        .OnDoubleClick = ""
    End With
End Sub
Sub info()
MsgBox "禁止复制、剪贴、删除、插入、拖拉式填充、双击修改单元格！！！", 64, "友情提示"
End Sub
Sub 关于复制()
MsgBox "本工具可以禁用以下菜单：" & Chr(10) & _
"【复制  剪切  粘贴  选择性粘贴  删除  插入  清除内容  双击  填充】" & Chr(10) _
& "在控选项面板可以禁用功能，但要恢复菜单和快捷键却要密码。" & Chr(10) & _
"请各位用户自己记住密码，同时不要外泄。" & Chr(10) _
& "本工具仅仅提供对VBA盲的防范，对高手是没用的。" & Chr(10) _
& "使用时将你的工作表移动到本工作簿然后禁用菜单与快捷键再寄给别人使用。", 64, "andysky"
End Sub
Sub 禁止()
UserForm1.Show 0
End Sub

终于让我打开了。。。。不好意思呀

随心所欲

打开了又怎样，理解了吗，切

dodo2000

该方法对excel2007已经无效了。

rzz8118

好贴，收藏以后备用。

stanleylo

有意思呀，这个也能做出来

gw221x

值得收藏，非常好的帖子

stephen1707

不错的功能，好用！

安全为主

原帖由 随心所欲 于 2010-7-21 22:13 发表
几天了，版主也不来看看

不能完全的恢复，右键的插入功能没有了，只能用excel的帮助修复功能才能完全恢复！！

Martinzhuchao

“插入行”功能不能恢复！！！

要如何才能恢复啊？？？？帮帮忙啊。

我觉得这个程序就跟个病毒差不多。没有实际意义，如果人家禁用VBA，不运行你这个程序，就没什么用处了。恢复还需要密码？何不关闭工作薄时自动恢复呢？