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
-
Problem: ich kann die Datei nicht wieder verlassen,
ohne Excel beenden zu müssen.
-
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
-
Problem: ich kann die Datei nicht wieder verlassen,
ohne Excel beenden zu müssen.
-
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]
-
Problem: ich kann die Datei nicht wieder verlassen,
ohne Excel beenden zu müssen.
-
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