Code verhindert Strg + V
31.07.2008 08:31:00
Reinhard
mit nachfolgendem Code mache ich ein "Fadenkreuz" für die markierte Zelle. Klappt auch bei ersten Tests.
Nur wenn ich Kopieren wähle bzw. Strg+C um woanderst den Zellinhalt einzufügen so setzt die Zeile:
If Not Merker Is Nothing Then Merker.Interior.ColorIndex = xlNone
den CutCopyMode zurück und es wird nichts eingefügt :-(
Was kann ich da tun?
Danke ^ Gruß
Reinhard
in Modul1:
Option Explicit
Public Merker As Range
Sub Faerben(Zelle As Range)
Dim Bereich
On Error GoTo Ende
'DoEvents
Application.ScreenUpdating = False
If Not Merker Is Nothing Then Merker.Interior.ColorIndex = xlNone
Set Bereich = Intersect(ActiveWindow.VisibleRange, Rows(Zelle.Row))
Set Bereich = Union(Bereich, Intersect(ActiveWindow.VisibleRange, Columns(Zelle.Column)))
Bereich.Interior.ColorIndex = Int(Rnd() * 55) + 2
Set Merker = Bereich
Ende:
Application.ScreenUpdating = True
End Sub
in Diese Arbeitsmappe:
Option Explicit
'
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Merker Is Nothing Then Merker.Interior.ColorIndex = xlNone
End Sub
'
Private Sub Workbook_Open()
Call Faerben(ActiveCell)
End Sub
'
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call Faerben(ActiveCell)
End Sub
'
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Not Merker Is Nothing Then Merker.Interior.ColorIndex = xlNone
End Sub
'
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call Faerben(Target)
End Sub