Stop af cut/copy

Jeg har brugt forskellige løsninger undervejs - de fleste fundet på nettet og videre bearbejdet til eget brug.

Jeg har her en kode jeg har fundet engang (kan ikke huske hvor) der stort set lukker for alt.

Den skal placeres i Thisworkbook - og filen skal gemmes, lukkes  og åbnes igen før den virker 100% da der er en del kode der ligger i Workbook_open modulet.

Den lukker bla helt for højrekliksmenuen, men da jeg ofte selv bruger denne til at placere makrokald i bruger jeg her ofte andre koder der "skjuler" de enkelte punkter i denne menu som jeg ikke ønsker skal bruges.

Men - Du kan prøve og se om det bringer dig videre ;-)

mvh Kurt


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

Genialt, den lukker stort set af for alt!
Send et svar, så får du dine point

Tak!

Hmm.. helt retfærdigt er det vel egentlig ikke at få point for noget man har fundet.... ;-) Men godt det kunne hjælpe/inspirere dig.

mvh Kurt