Hallo Wolf
Das stimmt! Zudem habe ich festgestellt, dass wenn ich ein anderes sheet dieser Arbeitsmappe zum aktuellen sheet mache auch hier die im vorderen sheet angewählten Zellen blinken.
Für beides gibt es Abhilfen.
Problem Mappe schliessen und wieder öffnen:
Der Inhalt der Variablen strAktiveZelle muss vor dem Schliessen der Arbeitsmappe mit dem Ereignismakro Private Sub Workbook_BeforeClose(Cancel As Boolean) in eine bestimmte Zelle (gewählt E1) geschrieben und gespeichert werden.
Beim Öffnen holt das Ereignismakro Private Sub Workbook_Open() die abgelegte Variable und startet die Blinkmechanik.
Problem blinken nur im bestimmten sheet:
Das kann man machen durch ergänzen der Adressen: statt Range(strAktiveZelle).Interior.Color = Farbe heisst es nun Sheets("markierte Zellen blinken").Range(strAktiveZelle).Interior.Color = Farbe
Bei mir heisst das Blinksheet "markierte Zellen blinken". Du kannst ohne weiteres einen andern Namen geben.
Du musst nun die nachfolgenden Makros sorgfältig bei Dir einbauen. Fehler verträgt die Chose keine!
Gruss
So nun die neuen und angepassten Makros:
Die Ereignismakros kommen im VBAPoject in diese Arbeitsmappe:
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("markierte Zellen blinken").Range("E1") = strAktiveZelle
End Sub
Private Sub Workbook_Open()
strAktiveZelle = Sheets("markierte Zellen blinken").Range("E1")
MarkierteZellenBlinken
End Sub
Das Doppelklickmakro (sofern Du das willst) kommt im VBAProject in das entsprechende Tabellenblatt:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
' Tastenkombination: Strg+b
If InStr(1, strAktiveZelle, Target.Address) = 0 Then
b = 1
strAktiveZelle = strAktiveZelle & "," & Selection.Address
If Left(strAktiveZelle, 1) = "," Then strAktiveZelle = Selection.Address
Else
b = 0
If strAktiveZelle <> "" Then
If strAktiveZelle = Replace(strAktiveZelle, "," & Selection.Address, "") Then
'die erste Adresse des strings soll ausgeschaltet werden
strAktiveZelle = Replace(strAktiveZelle, Selection.Address & ",", "")
Else
'jede andere Adresse des strings soll ausgeschaltet werden
strAktiveZelle = Replace(strAktiveZelle, "," & Selection.Address, "")
End If
End If
End If
MarkierteZellenBlinken
End Sub
Die Makros der Blinkmechanik kommen im VBAProject in ein Modul:
Option Explicit
Public strAktiveZelle As String
Public b
Sub BlinkenEin()
' Tastenkombination: Strg+b
b = 1
strAktiveZelle = strAktiveZelle & "," & Selection.Address
If Left(strAktiveZelle, 1) = "," Then strAktiveZelle = Selection.Address
MarkierteZellenBlinken
End Sub
Sub BlinkenAus()
' Tastenkombination: Strg+x
b = 0
If strAktiveZelle <> "" Then
If strAktiveZelle = Replace(strAktiveZelle, "," & Selection.Address, "") Then
'die erste Adresse des strings soll ausgeschaltet werden
strAktiveZelle = Replace(strAktiveZelle, Selection.Address & ",", "")
Else
'jede andere Adresse des strings soll ausgeschaltet werden
strAktiveZelle = Replace(strAktiveZelle, "," & Selection.Address, "")
End If
End If
MarkierteZellenBlinken
End Sub
Sub MarkierteZellenBlinken()
Dim t As Date
Dim m
Dim Farbe
Dim Schrift
If strAktiveZelle = "" Then Exit Sub
t = Now + TimeValue("00:00:01")
m = Format(t, "ss")
If m Mod 2 = 0 Then
Farbe = xlNone
Else:
Farbe = 255
End If
Sheets("markierte Zellen blinken").Range(strAktiveZelle).Interior.Color = Farbe
If b = 1 Then
'blinken Ein
Application.OnTime t, "MarkierteZellenBlinken"
Else
'blinken Aus
If strAktiveZelle = Selection.Address Then
'die letzte verbliebene Adresse des strings soll ausgeschaltet werden
Sheets("markierte Zellen blinken").Range(strAktiveZelle).Interior.Color = xlNone
strAktiveZelle = ""
Else
'die markierte Adresse des strings wird ausgeschaltet
Selection.Interior.Color = xlNone
b = 1
Application.OnTime t, "MarkierteZellenBlinken"
End If
End If
End Sub