Copy/Paste verhindern/ Für def. Bereich zulassen
19.07.2019 12:14:37
Sebastian
ich habe untenstehenden (oft gesuchten und viel kopierten) Code genutzt um das Kopieren/ Ausschneiden/ Einfügen in meinem Excel- Workbook zu verhindern.
Der Code funktioniert soweit tadellos, jedoch muss ich den Nutzern in bestimmten Bereichen das Kopieren/ Einfügen erlauben. "Kopieren" habe ich auskommentiert und darf in der ganzen Mappe verwendet werden.
Nun benötige ich die Einschränkung, dass in (Beispiel:) Tabelle1, Zeile A2 ein Text eingefügt werden darf.
Ist dies möglich?
Vielen Dank für die Hilfe
Code "Diese Arbeitsmappe":
Option Explicit
Private Sub Workbook_Activate() 'Copy&Paste verhindern_
Call ToggleCutCopyAndPaste(False)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'Copy&Paste verhindern_
Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Deactivate() 'Copy&Paste verhindern_
Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False) 'Copy&Paste verhindern_
End Sub
Code Modul1:
Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
'Call EnableMenuItem(19, Allow) ' copy
Call EnableMenuItem(22, Allow) ' paste
Call EnableMenuItem(755, Allow) ' pastespecial
'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow
'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
'.OnKey "^c", "CutCopyPasteDisabled"
.OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
.OnKey "+{DEL}", "CutCopyPasteDisabled"
.OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case Is = True
'.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
End Select
End With
End Sub
Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub
Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox "Sorry! Cutting, copying and pasting have been disabled in this workbook!"
End Sub