beliebige Zelle blinken lassen
#11
(19.08.2017, 13:16)Helvetier schrieb: Hallo Wolf
Was Du möchtest, geht natürlich! Vorgehen: Beispiel: setze den Cursor in F4+Ctrl gedrückt halten > G7 > H8 > Ctrl los lassen > Ctrl+b.
Du wirst sehen, dass Du ganze Bereiche markieren und blinken lassen kannst.
Zum stoppen kann der Cursor in irgend einer Zelle stehen > Ctrl+x.

Nachtrag: Oder meinst Du: zu bereits blinkenden Zellen / blinkenden Bereichen weitere hinzuschalten? Sollte dann auch das Abschalten "stufenweise" geschehen?
Gruss
Ich hätte die Anwendung konkreter beschreiben sollen:
Es geht um einen Kalender, den ich mir mit Excel nach meinen
Bedürfnissen erstellt habe. Um besoners wichtige Termine
hervorzuheben, hätte ich gern das Blinken. Die Erfahrung hat
mir gezeigt, dass ich rot unterlegte Zellen (manchmal) übersehe, blinken
nicht.
So wäre es gut zu bestimmten Zeiten, bestimmte Zellen blinken zu lassen.
Einen Tag später käme z.B. eine dazu, eine andere würde deaktiviert...
Gruß
Wolf
Gruß
Top
#12
Hallo Wolf
Also gemäss meinem Nachtrag!?
Nun hier ist schon mal die Version für das stufenweise Zuschalten. Bei jeder neuen Markierung ist das Ctrl+b auszuführen. Wenn das Deinen Vorstellungen entspricht, können wir uns um das Abschalten unterhalten. Ist dann etwas komplexer.
Code:
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
    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(Now, "ss")
   
    If m Mod 2 = 0 Then
        Farbe = xlNone
    Else:
        Farbe = 255
    End If
    Range(strAktiveZelle).Interior.Color = Farbe
   
    If b = 1 Then
        'blinken Ein
        Application.OnTime t, "MarkierteZellenBlinken"
    Else
        'blinken Aus
        Range(strAktiveZelle).Interior.Color = xlNone
        strAktiveZelle = ""
    End If
End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an Helvetier für diesen Beitrag:
  • Wolf06
Top
#13
Hallo Helvetier,
genau so, ist es für mich richtig!
Wolf
Top
#14
Hallo Wolf
Ich habe hier noch die Variante für das Ausschalten einzelner Zellen. Der Cursor muss dabei auf die auszuschaltende Zelle gesetzt werden. Ob es auch für Bereiche funktioniert die aus mehreren Zellen bestehen, habe ich nicht geprüft. Auch ist es möglich, dass noch Fehler produziert werden.
Gruss
Code:
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
            strAktiveZelle = Replace(strAktiveZelle, Selection.Address & ",", "")
        Else
            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(Now, "ss")
   
    If m Mod 2 = 0 Then
        Farbe = xlNone
    Else:
        Farbe = 255
    End If
    Range(strAktiveZelle).Interior.Color = Farbe
   
    If b = 1 Then
        'blinken Ein
        Application.OnTime t, "MarkierteZellenBlinken"
    Else
        'blinken Aus
        If strAktiveZelle = Selection.Address Then
            Range(strAktiveZelle).Interior.Color = xlNone
            strAktiveZelle = ""
        Else
            Selection.Interior.Color = xlNone
            b = 1
            Application.OnTime t, "MarkierteZellenBlinken"
        End If
    End If
End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an Helvetier für diesen Beitrag:
  • Wolf06
Top
#15
Hallo Helvetier,

sieht bisher wirklich gut aus. Das hilft mir wirklich sehr.
Ich danke Dir für Deine Mühe.
Herzliche Grüße
Wolf
Top
#16
Hallo Wolf
Statt umständlich Ctrl+b resp. Ctrl+x kann man auch mit Doppelklick arbeiten. Einschalten = Doppelklick in eine Zelle, die blinken soll. Ausschalten = Doppelklick in eine blinkende Zelle.
Das Makro unten im VBA Projekt in das entsprechende Tabellenblatt einfügen > dafür sorgen, dass in einem Modul die Prozedur MarkierteZellenBlinken (bei Dir vorhanden) und irgendwo strAktiveZelle und b als Public deklariert sind. Und los geht's. Einschränkung: Bereiche mit mehreren Zellen lassen sich nicht zuschalten / ausschalten.
Gruss
Code:
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
[-] Folgende(r) 1 Nutzer sagt Danke an Helvetier für diesen Beitrag:
  • Wolf06
Top
#17
Hallo Helvetier,
leider ist nach dem Speichern und neuem Aufrufen der Datei
das Blinken nicht mehr vorhanden...
Hast Du dafür (noch)eine Idee?
Danke im Voraus
Wolf
Top
#18
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
[-] Folgende(r) 1 Nutzer sagt Danke an Helvetier für diesen Beitrag:
  • Wolf06
Top
#19
Hallo Wolf
Und noch eine Korrektur um einen Fehler zu vermeiden beim Öffnen einer andern Arbeitsmappe:
Überall wo wir das sheet definiert haben, muss auch das Workbook definiert werden. Also ergänze bitte: in jeder Prozedur wird Sheets("markierte Zellen blinken").Range(strAktiveZelle) zu Thisworkbook.Sheets("markierte Zellen blinken").Range(strAktiveZelle)
Die Spielerei wird ganz langsam anspruchsvoll.
Gruss
[-] Folgende(r) 1 Nutzer sagt Danke an Helvetier für diesen Beitrag:
  • Wolf06
Top
#20
Hinweis an Wolf:

nutzt du weiter das Vollzitat, obwohl es nicht nötig ist, dann komme ich durch das Netz und zieh dir die Ohren lang. :51:
Ohne Zitat bitte den Button Antworten ganz unten nutzen
Mit freundlichen Grüßen  :)
Michael
[-] Folgende(r) 1 Nutzer sagt Danke an Zwergel für diesen Beitrag:
  • Wolf06
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste