Excel - Copy & Paste deaktivieren
01.06.2021 14:09:28
Emil
ich bin seit langer Zeit "Mitleser" und konnte viele tolle Formeln / VBA Codes entdecken, welche mir immer sehr weitergeholfen haben.
Meine Excel Kenntnisse sind gut; meine VBA Kenntnisse sind eher bescheiden; ich schaffe es ggfs. noch einen Code für mich abzuändern; einen erstellen kann ich jedoch nicht.
Ich habe eine große Excel-Datei, welche von Teamkolleginnen und Kollegen befüllt werden muss; ich habe die Datenüberprüfung aktiviert, so dass nur bestimmte Eingabemöglichkeiten vorhanden sind; diese definierten "Antworten" werte ich automatisch über eine ZählenWenn Formel aus; mein Problem ist, dass Kolleginnen und Kollegen die Datenüberprüfung (bewusst oder unbewusst) umgehen indem sie Inhalte mittels Copy+Paste einfügen.
Ich habe seit Tagen das Internet durchsucht und mehrere VBA Codes gefunden, welche das kopieren und einfügen verhindern sollen; jedoch sind die gesamten Codes ohne Funktion; kopierter Text aus der Zwischenablage hat sich leider immer einfügen lassen.
ich finde den Fehler nicht....
Derzeit verwende ich nachstehenden Code (http://schmidt-net.de/files/30038.htm);
dieser wurde wohl für Office 2003 geschrieben; bei mir (Office 2016) funktioniert er jedoch nicht.
Kann mir bitte jemand helfen oder mir sagen wo ich Hilfe finden kann?
vielen Dank vorab und viele Grüße, Emil
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
Private Sub Workbook_Activate()
CutCopyOff
End Sub
Private Sub Workbook_Deactivate()
CutCopyOn
End Sub
Private Sub Worksheet_Activate()
CutCopyOff
End Sub
Private Sub Worksheet_Deactivate()
CutCopyOn
End Sub