Re: Sorry, Nepumuk...
19.01.2003 23:47:41
Nepumuk
Hallo Andy,
folgenden Code in das Klassenmodul "Diese Arbeitsmappe":Option Explicit
Private Sub Workbook_Open()
Start
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Blinken_aus
End Sub
folgenden Code in ein "normales" Modul:
Option Explicit
Public Verzoegerung As Date, Zellen As String, Farbe As Integer
Public Sub Start()
Dim Zeile As Long, lztZeile As Long
Application.ScreenUpdating = False
With Range("A4:A65536")
.ClearContents
.Interior.ColorIndex = xlNone
End With
With Sheets(1)
.Activate
If .Range("K65536").End(xlUp).Row > .Range("M65536").End(xlUp).Row Then lztZeile = .Range("K65536").End(xlUp).Row Else lztZeile = .Range("M65536").End(xlUp).Row
For Zeile = 4 To lztZeile
If Day(Cells(Zeile, 11)) = Day(Date + 14) And Month(Cells(Zeile, 11)) = Month(Date + 14) Then
Zellen = Zellen & "A" & CStr(Zeile) & ","
Cells(Zeile, 1) = "Geburtstag"
lztZeile = Zeile
End If
If Day(Cells(Zeile, 13)) = Day(Date + 14) And Month(Cells(Zeile, 13)) = Month(Date + 14) And Year(Cells(Zeile, 13)) = Year(Date + 14) Then
Zellen = Zellen & "A" & CStr(Zeile) & ","
Cells(Zeile, 1) = "Frist abgelaufen"
lztZeile = Zeile
End If
Next Zeile
End With
Application.ScreenUpdating = True
If Zellen <> "" Then
ActiveWindow.ScrollRow = lztZeile
ActiveWindow.ScrollColumn = 1
Zellen = Mid(Zellen, 1, Len(Zellen) - 1)
Blinken_ein
End If
End Sub
Private Sub Blinken_ein()
Verzoegerung = Time + TimeSerial(0, 0, 1)
If Farbe = 3 Then Farbe = xlNone Else Farbe = 3
Range(Zellen).Interior.ColorIndex = Farbe
Application.OnTime Verzoegerung, "Blinken_ein"
End Sub
Public Sub Blinken_aus()
On Error Resume Next
Application.OnTime Verzoegerung, "Blinken_ein", , False
End Sub
Gruß
Nepumuk