[已解决]为什么禁用复制黏贴的代码不好用

水上漂123

我使用的版本是2010，代码如下（网上搜的）
Private Sub Workbook_Open()
    With Application
'屏蔽常用工具栏剪切、复制、粘贴
    .CommandBars(3).Controls("剪切(&T)").Enabled = False
    .CommandBars(3).Controls("复制(&C)").Enabled = False
    .CommandBars(3).Controls("粘贴(&P)").Enabled = False
'屏蔽单元格右键菜单中的剪切、复制、粘贴命令
    .CommandBars("Cell").Controls("剪切(&T)").Enabled = False
    .CommandBars("Cell").Controls("复制(&C)").Enabled = False
    .CommandBars("Cell").Controls("粘贴(&P)").Enabled = False
'屏蔽编辑菜单中的剪切、复制、粘贴命令
    .CommandBars(1).Controls("编辑(&E)").Controls("剪切(&T)").Enabled = False
    .CommandBars(1).Controls("编辑(&E)").Controls("复制(&C)").Enabled = False
    .CommandBars(1).Controls("编辑(&E)").Controls("粘贴(&P)").Enabled = False
'屏蔽键盘剪切、复制、粘贴键
    .OnKey "^x", ""
    .OnKey "^c", ""
    .OnKey "^v", ""
    End With
End Sub
启动结果是

最佳答案

月排行榜 / 总排行榜

today0427

2016-8-27 12:36

漂哥，这个也是网上搜的，我在2007试过了可以用，你看看行不行
在不想要他能够复制粘贴的工作表里写代码如下：

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Call test
   
3. End Sub
   

复制代码

然后在模块中写代码

1. Sub test()
   
2. Application.CommandBars(1).Controls(2).Controls(6).Enabled = False
   
3. 
   
4. Application.CommandBars("cell").Controls(3).Enabled = False
   
5. 
   
6. Application.CommandBars("column").Controls(3).Enabled = False
   
7. 
   
8. Application.CommandBars("row").Controls(3).Enabled = False
   
9. Application.CellDragAndDrop = False
   
10. End Sub
    

复制代码

如果想要单个工作表受此约束，其他工作表照常就在单个工作表输入这个

1. 
   
2. Private Sub Worksheet_Deactivate()
   
3. Call testt
   
4. End Sub
   
5. 
   
6. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
7. Call test
   
8. End Sub
   

复制代码

然后模块中输入这个

1. Option Explicit
   
2. 
   
3. Sub test()
   
4. Application.CommandBars(1).Controls(2).Controls(6).Enabled = False
   
5. 
   
6. Application.CommandBars("cell").Controls(3).Enabled = False
   
7. 
   
8. Application.CommandBars("column").Controls(3).Enabled = False
   
9. 
   
10. Application.CommandBars("row").Controls(3).Enabled = False
    
11. Application.CellDragAndDrop = False
    
12. End Sub
    
13. 
    
14. Sub testt()
    
15. Application.CommandBars(1).Controls(2).Controls(6).Enabled = True
    
16. 
    
17. Application.CommandBars("cell").Controls(3).Enabled = True
    
18. 
    
19. Application.CommandBars("column").Controls(3).Enabled = True
    
20. 
    
21. Application.CommandBars("row").Controls(3).Enabled = True
    
22. Application.CellDragAndDrop = True
    
23. End Sub
    

复制代码

感觉自己好啰嗦，不然看附件吧！ 222.rar (247 KB, 下载次数: 27)

2016-8-27 12:35 上传

点击文件名下载附件

跳转到最佳答案楼层

today0427

漂哥，这个也是网上搜的，我在2007试过了可以用，你看看行不行
在不想要他能够复制粘贴的工作表里写代码如下：

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Call test
   
3. End Sub
   

复制代码

然后在模块中写代码

1. Sub test()
   
2. Application.CommandBars(1).Controls(2).Controls(6).Enabled = False
   
3. 
   
4. Application.CommandBars("cell").Controls(3).Enabled = False
   
5. 
   
6. Application.CommandBars("column").Controls(3).Enabled = False
   
7. 
   
8. Application.CommandBars("row").Controls(3).Enabled = False
   
9. Application.CellDragAndDrop = False
   
10. End Sub
    

复制代码

如果想要单个工作表受此约束，其他工作表照常就在单个工作表输入这个

1. 
   
2. Private Sub Worksheet_Deactivate()
   
3. Call testt
   
4. End Sub
   
5. 
   
6. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
7. Call test
   
8. End Sub
   

复制代码

然后模块中输入这个

1. Option Explicit
   
2. 
   
3. Sub test()
   
4. Application.CommandBars(1).Controls(2).Controls(6).Enabled = False
   
5. 
   
6. Application.CommandBars("cell").Controls(3).Enabled = False
   
7. 
   
8. Application.CommandBars("column").Controls(3).Enabled = False
   
9. 
   
10. Application.CommandBars("row").Controls(3).Enabled = False
    
11. Application.CellDragAndDrop = False
    
12. End Sub
    
13. 
    
14. Sub testt()
    
15. Application.CommandBars(1).Controls(2).Controls(6).Enabled = True
    
16. 
    
17. Application.CommandBars("cell").Controls(3).Enabled = True
    
18. 
    
19. Application.CommandBars("column").Controls(3).Enabled = True
    
20. 
    
21. Application.CommandBars("row").Controls(3).Enabled = True
    
22. Application.CellDragAndDrop = True
    
23. End Sub
    

复制代码

感觉自己好啰嗦，不然看附件吧！ 222.rar (247 KB, 下载次数: 27)

2016-8-27 12:35 上传

点击文件名下载附件

搁浅2008

on error resume next