-----------------------------------------------------------------------Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
With Application
.CellDragAndDrop = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
.CutCopyMode = False
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In
Application.CommandBars.FindControls(ID:=19) 'copy
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In
Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In
Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In
Application.CommandBars.FindControls(ID:=755) ' Paste Special
Ctrl.Enabled = True
Next Ctrl
End Sub
Private Sub Workbook_Open()
On Error Resume Next
With Application
.CutCopyMode = False
.CellDragAndDrop = False
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
.OnKey "+{DEL}", ""
.OnKey "^{INSERT}", ""
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste
Special
Ctrl.Enabled = False
Next Ctrl
End Sub
Private Sub Workbook_Activate()
On Error Resume Next
With Application
.CutCopyMode = False
.CellDragAndDrop = False
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
.OnKey "+{DEL}", ""
.OnKey "^{INSERT}", ""
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste
Special
Ctrl.Enabled = False
Next Ctrl
End Sub
Private Sub
Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range,
Cancel As Boolean)
Cancel = True
MsgBox "Right click menu
deactivated." & vbCrLf & _
"For this file:", 16,
""
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal
Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh
As Object)
On Error Resume Next
With Application
.CutCopyMode = False
.CellDragAndDrop = False
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
.OnKey "+{DEL}", ""
.OnKey "^{INSERT}", ""
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21) ' Cut
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=755) ' Paste
Special
Ctrl.Enabled = False
Next Ctrl
End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
With Application
.CellDragAndDrop = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
.CutCopyMode = False
End With
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In
Application.CommandBars.FindControls(ID:=19) ' Copy
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21)
' Cut
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In
Application.CommandBars.FindControls(ID:=22) ' Paste
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In
Application.CommandBars.FindControls(ID:=755) ' Paste Special
Ctrl.Enabled = True
Next Ctrl
End Sub
---------------------------------------------------------------
Now your sheet is cut cope and paste protected.
Even confused then give a feed back I will solve it
spchwdhury@live.com
This work,
ReplyDeleteNow my sheet is protected without giving password