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

大福源

把代码发出来一起分享一下吧！还怕我们看不懂啊，VB开发我也懂点

ngs139

老师，EXCEL2007的工具栏上的复制与粘贴，没有被禁止掉，请完善

天遥

我的工作簿都没办法复制了
恢复也没有用.请具体给出解决方法

ivs008

谢谢分享
thanks

lwt2k

使用后会影响其他所有工作簿的，能不能只对禁止复制的工作簿生效呢？或者至少退出时能恢复Excel正常的复制粘贴功能吧？

youliqi

好好学习学习
谢谢版主

随心所欲

恢复以后，所有的功能都有了，就是选中整行的无法插入，求解？？？？

随心所欲

公司电脑上单元格，列都可以插入，除了行没办法，家里这台电脑夸张了，
鼠标右击都找不到插入，版主，想想办法吧，到底是哪里出问题了？

丰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

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