在指定范围内禁用粘贴动作

yf_home

触发事件，在指定范围内禁用粘贴动作，求解，谢谢！

　　　　　　　　测试附件： 指定范围内禁用粘贴动作.rar (9.02 KB, 下载次数: 7)

2013-7-24 10:43 上传

点击文件名下载附件

，，

yangyangzhifeng

试试看

1. Private Sub Workbook_Activate()With Application
   
2. 
   
3.         '屏蔽常用工具栏剪切 复制 粘贴
   
4.         .CommandBars(3).Controls("剪切(&T)").Enabled = False
   
5.         .CommandBars(3).Controls("复制(&C)").Enabled = False
   
6.         .CommandBars(3).Controls("粘贴(&P)").Enabled = False
   
7.         '屏蔽单元格右键菜单中的剪切 复制 粘贴命令
   
8.         .CommandBars("Cell").Controls("剪切(&T)").Enabled = False
   
9.         .CommandBars("Cell").Controls("复制(&C)").Enabled = False
   
10.         .CommandBars("Cell").Controls("粘贴(&P)").Enabled = False
    
11.         '屏蔽编辑菜单中的剪切 复制 粘贴命令
    
12.         .CommandBars(1).Controls("编辑(&E)").Controls("剪切(&T)").Enabled = False
    
13.         .CommandBars(1).Controls("编辑(&E)").Controls("复制(&C)").Enabled = False
    
14.         .CommandBars(1).Controls("编辑(&E)").Controls("粘贴(&P)").Enabled = False
    
15.         '屏蔽键盘剪切 复制 粘贴键
    
16.         .OnKey "^x", ""
    
17.         .OnKey "^c", ""
    
18.         .OnKey "^v", ""
    
19.     End With
    
20. End Sub
    
21. 
    
22. 
    
23. Private Sub Workbook_Deactivate()
    
24. With Application
    
25. 
    
26.         '屏蔽常用工具栏剪切 复制 粘贴
    
27.         .CommandBars(3).Controls("剪切(&T)").Enabled = True
    
28.         .CommandBars(3).Controls("复制(&C)").Enabled = True
    
29.         .CommandBars(3).Controls("粘贴(&P)").Enabled = True
    
30.         '屏蔽单元格右键菜单中的剪切 复制 粘贴命令
    
31.         .CommandBars("Cell").Controls("剪切(&T)").Enabled = True
    
32.         .CommandBars("Cell").Controls("复制(&C)").Enabled = True
    
33.         .CommandBars("Cell").Controls("粘贴(&P)").Enabled = True
    
34.         '屏蔽编辑菜单中的剪切 复制 粘贴命令
    
35.         .CommandBars(1).Controls("编辑(&E)").Controls("剪切(&T)").Enabled = True
    
36.         .CommandBars(1).Controls("编辑(&E)").Controls("复制(&C)").Enabled = True
    
37.         .CommandBars(1).Controls("编辑(&E)").Controls("粘贴(&P)").Enabled = True
    
38.         '屏蔽键盘剪切 复制 粘贴键
    
39.         .OnKey "^x"
    
40.         .OnKey "^c"
    
41.         .OnKey "^v"
    
42.     End With
    
43. End Sub
    

复制代码

yangyangzhifeng

修改为你需要的版本

1. 
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3.     With Application
   
4.         If Not Intersect(Target, Range("e4:e" & Range("e65536").End(3).Row)) Is Nothing Then
   
5.             '屏蔽常用工具栏 粘贴
   
6.             .CommandBars(3).Controls("粘贴(&P)").Enabled = False
   
7.             '屏蔽单元格右键菜单中的粘贴命令
   
8.             .CommandBars("Cell").Controls("粘贴(&P)").Enabled = False
   
9.             '屏蔽编辑菜单中的粘贴命令
   
10.             .CommandBars(1).Controls("编辑(&E)").Controls("粘贴(&P)").Enabled = False
    
11.             '屏蔽键盘粘贴键
    
12.             .OnKey "^v", ""
    
13.         Else
    
14.             '屏蔽常用工具栏剪切 复制 粘贴
    
15.             .CommandBars(3).Controls("粘贴(&P)").Enabled = True
    
16.             '屏蔽单元格右键菜单中的剪切 复制 粘贴命令
    
17.             .CommandBars("Cell").Controls("粘贴(&P)").Enabled = True
    
18.             '屏蔽编辑菜单中的剪切 复制 粘贴命令
    
19.             .CommandBars(1).Controls("编辑(&E)").Controls("粘贴(&P)").Enabled = True
    
20.             '屏蔽键盘剪切 复制 粘贴键
    
21.             .OnKey "^v"
    
22.         End If
    
23.     End With
    
24. End Sub

复制代码

yf_home

yangyangzhifeng 发表于 2013-7-24 10:55
试试看

感谢，但这个不是指定范围哦。

东亚五金

留个记号，等待学习

yf_home

再请教个问题，用EXCEL2010打开的话，屏蔽菜单栏的粘贴那条语句，好像对excel2010功能区无效。

yangyangzhifeng

yf_home 发表于 2013-7-24 11:37
再请教个问题，用EXCEL2010打开的话，屏蔽菜单栏的粘贴那条语句，好像对excel2010功能区无效。

我没有2010，你自己修改吧，可能菜单名称不一样

yf_home

自定常用工具栏有个贴上值的按钮，怎么用下列代码无效？

CommandBars(3).Controls("贴上值").Enabled = False

yangyangzhifeng

运行一下以下代码，自己定位粘贴菜单位置后修改代码

1. Sub Lqc_List() '分层次显示Excel菜单及工具栏的Index、ID、CaptionSheets.Add
   
2. i = 0
   
3. For Each cmd In CommandBars
   
4. i = i + 1
   
5. Cells(i, 1) = "Index:" & cmd.Index
   
6. Cells(i, 2) = "Name:" & cmd.Name
   
7.    For Each ctl In CommandBars(cmd.Name).Controls
   
8.       i = i + 1
   
9.       Cells(i, 3) = "Index:" & ctl.Index
   
10.       Cells(i, 4) = "ID:" & ctl.ID
    
11.       Cells(i, 5) = "Caption:" & ctl.Caption
    
12.           CtrNum1 = 0
    
13.           On Error Resume Next
    
14.           CtrNum1 = ctl.Controls.Count
    
15.           On Error GoTo 0
    
16.           If CtrNum1 >= 1 Then
    
17.              For Each ctl1 In ctl.Controls
    
18.              i = i + 1
    
19.              Cells(i, 6) = "Index:" & ctl1.Index
    
20.              Cells(i, 7) = "ID:" & ctl1.ID
    
21.              Cells(i, 8) = "Caption:" & ctl1.Caption
    
22.                  CtrNum2 = 0
    
23.                  On Error Resume Next
    
24.                  CtrNum2 = ctl1.Controls.Count
    
25.                  On Error GoTo 0
    
26.                  If CtrNum2 >= 1 Then
    
27.                     For Each ctl2 In ctl1.Controls
    
28.                     i = i + 1
    
29.                     Cells(i, 9) = "Index:" & ctl2.Index
    
30.                     Cells(i, 10) = "ID:" & ctl2.ID
    
31.                     Cells(i, 11) = "Caption:" & ctl2.Caption
    
32.                         CtrNum3 = 0
    
33.                         On Error Resume Next
    
34.                         CtrNum3 = ctl2.Controls.Count
    
35.                         On Error GoTo 0
    
36.                         If CtrNum3 >= 1 Then
    
37.                            For Each ctl3 In ctl2.Controls
    
38.                            i = i + 1
    
39.                            Cells(i, 12) = "Index:" & ctl3.Index
    
40.                            Cells(i, 13) = "ID:" & ctl3.ID
    
41.                            Cells(i, 14) = "Caption:" & ctl3.Caption
    
42.                            Next ctl3
    
43.                         End If
    
44.                     Next ctl2
    
45.                  End If
    
46.              Next ctl1
    
47.           End If
    
48.    Next ctl
    
49. Next
    
50. End Sub
    

复制代码

yf_home

感谢，试试。