Mal wieder blinkender Text

Hallo zusammen,

mit folgendem Makro habe ich es geschafft, mit „Makro ausführen“
die Zellen R3 und R4 zum Blinken zu bringen:

In die Tabelle

Private Sub Worksheet_Activate()
Call blink
End Sub

Private Sub Worksheet_Deactivate()
Application.OnTime start, „blink“, False
End Sub

In ein Modul

Option Explicit
Public start As Date

Sub blink()
If Sheets(1).Range(„R3:R4“).Font.ColorIndex = xlColorIndexAutomatic Then
Sheets(1).Range(„R3:R4“).Font.ColorIndex = 2 ’ bemerkung
Else: Sheets(1).Range(„R3:R4“).Font.ColorIndex = xlColorIndexAutomatic
End If
start = Now + TimeValue(„00:00:01“)
Application.OnTime start, „blink“
End Sub

  1. Problem: ich kann die Datei nicht wieder verlassen,
    ohne Excel beenden zu müssen.

  2. Wie kann ich im sagen, daß R3 und R4 beim Öffnen der Datei
    3x blinken sollen? Danach sollte die ursprüngliche Farbe
    wieder hergestellt werden.

Ich bin leider kein VBA-Künstler
Kann jemand helfen?

Gruß und danke

Rolf

  1. Problem: ich kann die Datei nicht wieder verlassen,
    ohne Excel beenden zu müssen.

  2. Wie kann ich im sagen, daß R3 und R4 beim Öffnen der Datei
    3x blinken sollen? Danach sollte die ursprüngliche Farbe
    wieder hergestellt werden.

Hi Rolf,
ich wußte nicht ob "ursprüngliche farbe eine andere ist als bei dir genannt. Weiterhin, wenn R3 und R4 die gleiche Farbe haben, kannst du sie ja zu R3:R4 zusammenfassen.
in DieseAbeitsmappe :

Option Explicit
Private Sub Workbook_Open()
FarbeR3 = Worksheets(1).Range(„R3“).Font.ColorIndex
FarbeR4 = Worksheets(1).Range(„R4“).Font.ColorIndex
Worksheets(2).Activate
Worksheets(1).Activate
End Sub

In Tabelle1 :

Option Explicit
Private Sub Worksheet_Activate()
Call blink
End Sub

Private Sub Worksheet_Deactivate()
Application.OnTime start, „blink“, False
End Sub

In ein Modul :

Option Explicit
Public start As Date
Public FarbeR3 As Integer
Public FarbeR4 As Integer
Sub blink()
Static n As Byte
n = n + 1
If n = 7 Then
 Sheets(1).Range("R3").Font.ColorIndex = FarbeR3
 Sheets(1).Range("R4").Font.ColorIndex = FarbeR4
 Exit Sub
End If
If Sheets(1).Range("R3:R4").Font.ColorIndex = xlColorIndexAutomatic Then
 Sheets(1).Range("R3:R4").Font.ColorIndex = 2 ' bemerkung
Else
 Sheets(1).Range("R3:R4").Font.ColorIndex = xlColorIndexAutomatic
End If
start = Now + TimeValue("00:00:01")
Application.OnTime start, "blink"
End Sub

Gruß
Reinhard

Hallo Reinhard

das klappt prima, mit Farbe und Zeit
experimentiere ich noch etwas.

Vielen herzlichen Dank

Gruß

rolf

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

  1. Problem: ich kann die Datei nicht wieder verlassen,
    ohne Excel beenden zu müssen.

  2. Wie kann ich im sagen, daß R3 und R4 beim Öffnen der Datei
    3x blinken sollen? Danach sollte die ursprüngliche Farbe
    wieder hergestellt werden.

Ich bin leider kein VBA-Künstler
Kann jemand helfen?

Gruß und danke

Rolf

Hallo Rolf,
bei deiner Version wird die OnTime Aktion im Sekundentakt in eine Endlos-Schleife geschickt und das Makro nie beendet. Dadurch das Problem beim Speichern/Verlasen der Datei.

Durch einfügen eines Zählers wird der Timer jetzt nach der vorgegeben Anzahl Durchläufen abgeschaltete. Ich hab die Makros so abgeändert, dass die Schrift in den Zellen R3:R4 eine beliebige Farbe haben können.
Beim Öffnen der Datei wird jetzt immer Sheet 1 angezeigt und der Blinker startet.
Beim Wechsel von einem anderm Blatt zum Sheet 1 wird ebenfalls der Blinker aktiviert.
So sehen die Makros jetzt aus. Dabei muß der Abschaltbefehl für OnTime unter „Private Sub Worksheet_Deactivate()“ weggelassen werden, sonst gibt es eine Fehlermeldung.

in DieseArbeitsmappe

Private Sub Workbook\_Open()
 ThisWorkbook.Sheets(1).Activate
End Sub


In der Tabelle:

Private Sub Worksheet\_Activate()
 Zaehler = 0
 TextfarbeR3 = Sheets(1).Range("R3").Font.ColorIndex
 TextfarbeR4 = Sheets(1).Range("R4").Font.ColorIndex
 Call blink
End Sub

im Modul:

Option Explicit
Public start As Date, Zaehler As Integer, TextfarbeR3 As Integer, TextfarbeR4 As Integer

Sub blink()
 If Sheets(1).Range("R3").Font.ColorIndex = TextfarbeR3 Then
 Sheets(1).Range("R3:R4").Font.ColorIndex = 2 ' bemerkung
 Else
 Sheets(1).Range("R3").Font.ColorIndex = TextfarbeR3
 Sheets(1).Range("R4").Font.ColorIndex = TextfarbeR4
 End If
 start = Now + TimeValue("00:00:01")
 Zaehler = Zaehler + 1
 Application.OnTime start, "blink"
 If Zaehler = 7 Then ' 2 Durchläufe= 1 mal Blinken
 Application.OnTime start, "blink", , False
 Sheets(1).Range("R3").Font.ColorIndex = TextfarbeR3
 Sheets(1).Range("R4").Font.ColorIndex = TextfarbeR4
 End If
End Sub

Gruß
Franz

Hallo Franz,

Private Sub Workbook_Open()
ThisWorkbook.Sheets(1).Activate
End Sub

löst nicht Worksheet_Activate aus. Deshalb habe ich erst Blatt2 dann Blatt1 aktiviert, dann klappt es beim Öffnen der Datei.
Oder in Workbook_Open auch schon blink aufrufen usw.

Gruß
Reinhard