怎么才能让工作表禁止复制粘贴功能啊？

erblet

各位老师：
   我刚才在工作表编辑器中写了一段代码，本来是想实现禁止工作表的复制和粘贴功能，但是写进去后，在调试的时候总是提示“运行时错误 无效的调用或参数”请哪位老师指点一下，谢谢！
代码是：
Private Sub Worksheet_Activate()
     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

邓江波

楼主是否可以通过保护工作表来禁止复制粘贴呢？

doitbest

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub
在thisworkbook模块中加入此事件宏

tianhua_30005

doitbest 发表于 2011-11-11 15:11
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.Cu ...

以下是本人在网上搜索后用工具破解的代码，很好用，可以禁止很多项，如禁止复制、粘贴、清除、填充等自己运行看吧。
窗体代码为：
Private Sub CommandButton2_Click()
Dim comm As Control
For Each comm In Me.Controls
If TypeName(comm) = "CheckBox" Then comm.Value = True
Next
End Sub
Private Sub CommandButton3_Click()
Dim comm As Control
For Each comm In Me.Controls
If TypeName(comm) = "CheckBox" Then comm.Value = False
Next
End Sub
Private Sub UserForm_Activate()
If Application.InputBox("请输入密码：", "权限验证", "不知道", Type:=1) <> 119 Then MsgBox "你没有操作权限": Unload Me: Exit Sub
Dim comm As Control
For Each comm In Me.Controls
If TypeName(comm) = "CheckBox" Then comm.Value = True
Next
End Sub
Private Sub CommandButton1_Click()
Dim comm As Control, i As Byte
i = 1
For Each comm In Me.Controls
If TypeName(comm) = "CheckBox" Then
Sheets("andy").Cells(i, 1).Value = comm.Value
i = i + 1
End If
Next
Dim ComBar As CommandBar
Dim ComBarCtrl As CommandBarControl
    EnableControl 295, Me.CheckBox5.Value '// ..cells
    EnableControl 296, Me.CheckBox5   '// ..Rows
    EnableControl 297, Me.CheckBox5.Value   '// ..Cols
    EnableControl 6002, Me.CheckBox2.Value  '// ..Cols
    EnableControl 478, Me.CheckBox6.Value  '// Edit > Delete...
    EnableControl 292, Me.CheckBox6.Value  '// &Delete...
    EnableControl 293, Me.CheckBox6.Value '// Row
    EnableControl 294, Me.CheckBox6.Value  '// Column
    EnableControl 847, Me.CheckBox6.Value  '// RightClick Tab
    EnableControl 21, Me.CheckBox3.Value   '// cut
    EnableControl 19, Me.CheckBox1.Value   '// copy
    EnableControl 22, Me.CheckBox2.Value   '// paste
    EnableControl 755, Me.CheckBox4.Value  '// pastespecial
    EnableControl 3125, Me.CheckBox6.Value '// Clear Contents
    EnableControl 1964, Me.CheckBox6.Value '// All
    EnableControl 872, Me.CheckBox6.Value  '// Formats
    EnableControl 755, Me.CheckBox4.Value  '// Formats
    EnableControl 873, Me.CheckBox6.Value  '// Contents
    EnableControl 874, Me.CheckBox6.Value  '// Comments
    EnableControl 809, Me.CheckBox2.Value   '// pastespecial
Application.CommandBars("cell").Controls(4).Enabled = False
    With Application
    If Me.CheckBox7 = False Then .OnKey "^c", "info"
    If Me.CheckBox7 = True Then .OnKey "^c"
    If Me.CheckBox8 = False Then .OnKey "^v", "info"
    If Me.CheckBox8 = True Then .OnKey "^v"
    If Me.CheckBox9 = False Then .OnKey "^x", "info"
    If Me.CheckBox9 = True Then .OnKey "^x"
    If Me.CheckBox10 = False Then .OnKey "{del}", "info"
    If Me.CheckBox10 = True Then .OnKey "{del}"
     .CellDragAndDrop = Me.CheckBox12.Value
    If Me.CheckBox11 = False Then .OnDoubleClick = "info"
    If Me.CheckBox11 = True Then .OnDoubleClick = ""
    End With
ThisWorkbook.Save
    Unload Me
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 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

tianhua_30005

tianhua_30005 发表于 2011-11-11 17:09
以下是本人在网上搜索后用工具破解的代码，很好用，可以禁止很多项，如禁止复制、粘贴、清除、填充等自己 ...

不足之处是只能全部禁止，或全部恢复，还没有只能禁止个别项，禁止保存后再打开要么全部禁止要么已全部恢复。本人也正在求其它高手解决此问题。

erblet

doitbest 发表于 2011-11-11 15:11
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.Cu ...

高手就是高手  一句话就解决问题了  赞

tianhua_30005

erblet 发表于 2011-11-12 21:22
高手就是高手  一句话就解决问题了  赞

运用此法只能在EXCEL中禁止，如果是从WORD或别的该当中复制的数据，再在EXCEL单元格中双击，然后再运用CTRL+V，便会轻轻松松地将数据复制到EXCEL单元格中，如果能彻底禁止在EXCEL中复制粘贴数据就好了，期盼中。。。。。

风云际会6

学习中,不知有没用

liucqa

留个记号               

mayfor

既要让人看，又不让人复制，干脆截图给别人算了。