Kopieren/Ausschneiden verhindern - auch Menüband
06.11.2013 10:23:47
Wolfango
mein Ziel:
In einer Excel-Tabelle soll jedes Auschneiden/Kopieren/Einfügen verhindert werden.
Das Blatt ist geschützt, etliche Zellen sind nicht gesperrt und genau hier soll o.g. verhindert werden.
im Netz habe ich untenstehenden VBA-Code gefunden. Der führt mich auch schon fast zum Ziel.
- Drag and Drop funktioniert nicht mehr
- Kopieren/Ausschneiden über das Kontextmenü wird ebenfalls deaktiviert
- Kopieren/Ausschneiden über Shortcuts wird ebenfalls deaktiviert
aber:
- der Kopier/Ausschneiden-Befehl im Menüband ist leider noch aktiv
Was muss ich am Code ändern?
Kann es sein, dass der Code noch für eine ältere Excel-Version (ohne Menüband) geschrieben wurde und nun an 2010 angepasst werden muss?
Vorab schon mal vielen Dank!
Gruß,
Wo
Private Sub Workbook_Activate()
CutCopyOff
End Sub
Private Sub Workbook_Deactivate()
CutCopyOn
End Sub
Sub CutCopyOff()
CutCopyOnOff 19, False 'Menübefehl "Kopieren"
CutCopyOnOff 21, False 'Menübefehl "Ausschneiden"
CutCopyOnOff 22, False 'Menübefehl "Einfügen"
CutCopyOnOff 755, False 'Menübefehl "Inhalte einfügen"
Application.OnKey "^c", "" 'Kopieren mit "Strg + C"
Application.OnKey "^x", "" 'Ausschneiden mit "Strg + X"
Application.OnKey "^v", "" 'Einfügen mit "Strg + V"
Application.OnKey "^{INSERT}", "" 'Kopieren mit "Strg + Einfg"
Application.OnKey "+{DEL}", "" 'Ausschneiden mit "Umsch + Entf"
Application.OnKey "+{INSERT}", "" 'Einfügen mit "Umsch + Einfg"
Application.CellDragAndDrop = False 'Ziehen mit der Maus
End Sub
Sub CutCopyOn()
CutCopyOnOff 19, True
CutCopyOnOff 21, True
CutCopyOnOff 22, True
CutCopyOnOff 755, True
Application.OnKey "^c"
Application.OnKey "^x"
Application.OnKey "^v"
Application.OnKey "^{INSERT}"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub
Sub CutCopyOnOff(Id As Variant, AnAus As Boolean)
Dim cb As CommandBar
Dim ctl As CommandBarControl
For Each cb In Application.CommandBars
Set ctl = cb.FindControl(Id:=Id, Recursive:=True)
If Not ctl Is Nothing Then ctl.Enabled = AnAus
Next
End Sub