Timer bei excelstart lässt Mappe abstürzen
08.01.2005 12:05:33
chris
Wie kann ich dieses Problem lösen so das ich auch während das Makro dei Uhrzeit schreibt in Excel klicken kann ?
Vielen dank für eure Hilfe. Hier noch der Code der bei mir ausgeführt wird beim excelstart.
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As _
Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As _
Long, ByVal nIDEvent As Long) As Long
Public TimerEnabled As Boolean
Public Cnt&
Dim hTimer&
Dim x
Dim satz
Dim laenge
Dim t As Date
Public Sub Init(Interval&)
x = 0
Datum = Date
wochentag = Weekday(Date)
Select Case wochentag
Case 1
wochentag = "Sonntag"
Case 2
wochentag = "Montag"
Case 3
wochentag = "Dienstag"
Case 4
wochentag = "Mittwoch"
Case 5
wochentag = "Donnerstag"
Case 6
wochentag = "Freitag"
Case 7
wochentag = "Samstag"
End Select
t = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
KW = ((Datum - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
satz = "Heute ist -- " & wochentag & " der " & Date & " -- Kalenderwoche " & KW
laenge = Len(satz)
hTimer = SetTimer(0, 0, Interval, AddressOf TimerProc)
TimerEnabled = True
End Sub
Public Sub Terminate()
Call KillTimer(0, hTimer)
TimerEnabled = False
Exit Sub
End Sub
Sub auto_open()
cb = Application.UserName
If cb "chris" Then
ThisWorkbook.Close False
End If
Call Init(30)
End Sub
Private Sub TimerProc(ByVal hWnd&, ByVal Msg&, ByVal idEvent&, ByVal dwTime&)
x = x + 1
If x = laenge + 1 Then
Call KillTimer(0, hTimer)
TimerEnabled = False
Exit Sub
Else
'Scheibt aktuelles Datum und Kalenderwoche in die statusleiste
Application.StatusBar = Mid(satz, 1, x)
End If
End Sub