frage an Hajo Blinkende Zellen
23.06.2009 07:30:03
chris
ich habe mir von Deiner Seite ´die Mappe heruntergeladen in denen meherer zellen untereinander blinken.
Aber ich bekomme es einfach nicht hin das mehr als 60 Zellen blinken ?
geht das überhaupt ?
Es handelt sich z.b um deinen Code "blinkende Zelle3"
Den habe ich so abgeändert klappt aber nicht.
Es blinken nicht mehr als 60 Zellen.
wenn ich mehr werte eingebe als 60 blinkt nichts mehr.
Was kann ich tun ? Hier ich der Code aus Dem Codemodule
Option Explicit ' Variablendefinition erfdorderlich
Option Private Module ' Makro nicht unter Extra, Makro sichtbar
Option Base 1 ' Array begnnt bei 1 und nicht wie Standard bei 0
'**************************************************
'* H. Ziplies *
'* 14.01.07 *
'* erstellt von Hajo.Ziplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
' das Schreiben der Startzeit auf eine Variable hat den Vorteil das die Prozedur leichter angehalten werden kann
Dim DaEt1 As Date ' Zeit erste Farbe
Dim DaEt2 As Date ' Zeit zweite Farbe
Public InWerte(100) As Integer ' Farbe zu Beginn, Integer da keine Farbe negativ
Public BoZustand As Boolean ' Zustand blinken, False =Ein
Dim VaArr1 As Variant ' Bereich erste Farbe
Dim VaArr2 As Variant ' Bereich zweite Farbe
' weiterentwicklung von Lutz aus dem Herberforum auf der Grundlage des Codes
' blinkende Zelle von der Seite http://home.media-n.de/ziplies/ neue Adresse Hajo-Excel.de
Public Const InFarbe1 = 3 ' erste Farbe negativ
Public Const InFarbe2 = 5 ' zweite Farbe positiv
Public Const InFarbe3 = 4 ' dritte Farbe negativ
Public Const InFarbe4 = 6 ' vierte Farbe positiv
Public Const DaZeit As Date = "00:00:01" ' Zeitabstand Blinken
Sub erste_Farbe() ThisWorkbook.Worksheets("Tabelle1").Range(VaArr1).Interior.ColorIndex = InFarbe1 DaEt1 = Now + DaZeit ' neue Startzeit setzen Application.OnTime DaEt1, "dritte_Farbe" ' Prozedur zur Startzeit starten End Sub
Sub zweite_Farbe()
ThisWorkbook.Worksheets("Tabelle1").Range(VaArr2).Interior.ColorIndex = InFarbe2
DaEt2 = Now + DaZeit ' neue Startzeit setzen
Application.OnTime DaEt2, "vierte_Farbe" ' Prozedur zur Startzeit starten
End Sub
Sub dritte_Farbe()
ThisWorkbook.Worksheets("Tabelle1").Range(VaArr1).Interior.ColorIndex = InFarbe3
DaEt1 = Now + DaZeit ' neue Startzeit setzen
Application.OnTime DaEt1, "erste_Farbe" ' Prozedur zur Startzeit starten
End Sub
Sub vierte_Farbe()
ThisWorkbook.Worksheets("Tabelle1").Range(VaArr2).Interior.ColorIndex = InFarbe4
DaEt2 = Now + DaZeit ' neue Startzeit setzen
Application.OnTime DaEt2, "zweite_Farbe" ' Prozedur zur Startzeit starten
End Sub
Sub Ende()
On Error Resume Next
Application.OnTime EarliestTime:=DaEt1, Procedure:="erste_Farbe", Schedule:=False
Application.OnTime EarliestTime:=DaEt2, Procedure:="zweite_Farbe", Schedule:=False
Application.OnTime EarliestTime:=DaEt1, Procedure:="dritte_Farbe", Schedule:=False
Application.OnTime EarliestTime:=DaEt2, Procedure:="vierte_Farbe", Schedule:=False
Farbe_zurück
End Sub
Sub Start()
Dim iCounter As Integer
Ende ' Blinken abschalten
VaArr1 = "" ' Variable leeren da Zellen neu verglichen _
werden
VaArr2 = "" ' Variable leeren da Zellen neu verglichen _
werden
On Error Resume Next
For iCounter = 1 To 100
' Ergänzung Hajo
If IsNumeric(Cells(iCounter, 1)) Then
If Range("A" & iCounter) 50 Then
VaArr2 = VaArr2 & "," & "A" & iCounter
End If
End If
Next iCounter
' Veränderung Hajo
If Len(VaArr1) > 1 Then
VaArr1 = Mid(VaArr1, 2, Len(VaArr1) - 1)
erste_Farbe
End If
If Len(VaArr2) > 1 Then
VaArr2 = Mid(VaArr2, 2, Len(VaArr2) - 1)
zweite_Farbe
End If
End Sub
Sub Farbe_zurück()
Dim ByI As Byte
With ThisWorkbook.Worksheets("Tabelle1")
For ByI = 1 To 100
.Cells(ByI, 1).Interior.ColorIndex = InWerte(ByI)
Next ByI
End With
End Sub
Sub Farbe_auslesen()
Dim ByI As Byte
With ThisWorkbook.Worksheets("Tabelle1")
For ByI = 1 To 100
InWerte(ByI) = .Cells(ByI, 1).Interior.ColorIndex
Next ByI
End With
End Sub
Vielen Dank gruß Chris