EXCEL: Kein Kopieren und Einfuegen moeglich durch Macro

[CoregaTab]

Hallo, ich habe folgende Macro in einer Excel Datei erstellt um ein Drag and Drop der Zellen zu verhindern.

Option Explicit

Private Sub Workbook_Activate()
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_Deactivate()
Application.CellDragAndDrop = True
End Sub

Jetzt kann ich aber kein Kopieren und Einfuegen machen. An was liegt das?
Es wird durch die Macro ja nur die Option deaktiviert.
Wenn ich die Funktion manuel deaktiviere dann ist es kein Problem.

Vielen Dank

 

[Snooty]

Du kannst die Funktionen für Ausschneiden/Einfügen/Kopieren separat aktivieren:

http://www.alant.com/excel/324-deaktiveren-von-ausschneiden-kopieren-und-einfuegen.html

 

[CoregaTab]

Danke, muss ich mir zu Hause ansehen weil es auf der Arbeit geperrt ist. Es ist nur komisch das ich in der Datei Kopieren Einfuegen kann aber in eine andere Excel Datei das nicht geht es sei denn ich loesche die oben genannte Macro wieder.

 

[Snooty]

Das ist der Code von dort (http://www.alant.com/excel/324-deaktiveren-von-ausschneiden-kopieren-und-einfuegen.html). Grundsätzlich wird dort alles gesperrt bzw. alles freigegeben. Du musst es halt für dich entsprechend anpassen, damit Drag'n'drop gesperrt ist aber der Rest nicht.

Option Explicit

Sub EnableControl(Id As Integer, Enabled As Boolean)
Dim CB As CommandBar
Dim C As CommandBarControl
For Each CB In Application.CommandBars
Set C = CB.FindControl(Id:=Id, recursive:=True)
If Not C Is Nothing Then C.Enabled = Enabled
Next
End Sub

Private Sub Workbook_Activate()
' Die Befehlsschaltflächen deaktivieren
 EnableControl 21, False ' Ausschneiden (cut)
 EnableControl 19, False ' Kopieren (copy)
 EnableControl 22, False ' Einfügen (paste)
 EnableControl 755, False ' Inhalte Einfügen (pastespecial)
' Tastenkombinationen abfangen
 Application.OnKey "^c", "" ' STRG + c kopieren abfangen (copy)
 Application.OnKey "^v", "" ' STRG + v einfügen abfangen (cut)
 Application.OnKey "^x", "" ' STRG + x ausschneiden abfangen (cut)
 Application.OnKey "+{DEL}", "" ' SHIFT + ENTF auschneiden abfangen (cut)
 Application.OnKey "+{INSERT}", "" ' SHIFT + EINFG einfügen abfangen (paste)
' Zellen mit dem Randanfasser verschieben, kopieren verhindern 
 Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_Open()
' Die Befehlsschaltflächen deaktivieren
 EnableControl 21, False ' Ausschneiden (copy)
 EnableControl 19, False ' Kopieren (copy)
 EnableControl 22, False ' Einfügen (paste)
 EnableControl 755, False ' ' 
' Tastenkombinationen abfangen
 Application.OnKey "^c", "" ' STRG + c Kopieren (copy)
 Application.OnKey "^v", "" ' STRG + v (cut)
 Application.OnKey "^x", "" ' STRG + x (paste)
 Application.OnKey "+{DEL}", "" ' SHIFT + ENTF (cut)
 Application.OnKey "+{INSERT}", "" ' SHIFT + EINFG (paste)
' Zellen mit dem Randanfasser verschieben, kopieren wieder ermöglichen
 Application.CellDragAndDrop = False
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Die Befehlsschaltflächen wieder aktivieren
 EnableControl 21, True ' Ausschneiden (cut)
 EnableControl 19, True ' Kopieren (copy)
 EnableControl 22, True ' Einfügen (paste)
 EnableControl 755, True ' pastespecial
' Tastenkombinationen abfangen
 Application.OnKey "^c" ' STRG + c (copy)
 Application.OnKey "^v" ' STRG + v (cut)
 Application.OnKey "^x" ' STRG + x (cut)
 Application.OnKey "+{DEL}" ' SHIFT + ENTF (cut)
 Application.OnKey "+{INSERT}" ' SHIFT + EINFG (paste)
' Zellen mit dem Randanfasser verschieben, kopieren wieder ermöglichen
 Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Deactivate()
' Die Befehlsschaltflächen wieder aktivieren
 EnableControl 21, True ' Kopieren (copy)
 EnableControl 19, True ' Kopieren (copy)
 EnableControl 22, True ' Einfügen (paste)
 EnableControl 755, True ' ' Inhalte Einfügen (pastespecial)

' Tastenkombinationen wieder einschalten
 Application.OnKey "^c" ' STRG + c Kopieren (copy)
 Application.OnKey "^v" ' STRG + v Einfügen (paste)
 Application.OnKey "^x" ' STRG + v ausschneiden (cut)
 Application.OnKey "+{DEL}" ' SHIFT + ENTF (cut)
 Application.OnKey "+{INSERT}" ' SHIFT + EINFG (paste)
' Zellen mit dem Randanfasser verschieben, kopieren wieder ermöglichen
 Application.CellDragAndDrop = True
End Sub

 

[CoregaTab]

Super... Vielen Dank