Gruppe
Ereignis
Problem
Wie kann ich die Zeitangabe in einer Zelle und der Statusbar jede Sekunde aktualisieren und die Tabelle jede Minute als HTMLDatei speichern lassen?
StandardModule: basMain
Public Const gsMacroA As String = "UpdateClock"
Public Const gsMacroB As String = "UpdateHTML"
Public gdNextTimeA As Double
Public gdNextTimeB As Double
Sub StartClock()
gdNextTimeA = Now + TimeSerial(0, 0, 1)
Application.OnTime earliesttime:=gdNextTimeA, _
procedure:=gsMacroA, schedule:=True
End Sub
Private Sub UpdateClock()
Application.DisplayStatusBar = True
ThisWorkbook.Worksheets("Uhrzeit").Range("A1").Calculate
Application.StatusBar = "Zeit: " & Format(Time, "hh:mm:ss")
Call StartClock
End Sub
Sub StopClock()
On Error Resume Next
Application.OnTime earliesttime:=gdNextTimeA, _
procedure:=gsMacroA, schedule:=False
Application.StatusBar = False
End Sub
Sub StartHTML()
Dim iIntervall As Integer
iIntervall = ThisWorkbook.Worksheets("Uhrzeit").Range("D1").Value
gdNextTimeB = Now + TimeSerial(0, iIntervall, 0)
Application.OnTime earliesttime:=gdNextTimeB, _
procedure:=gsMacroB, schedule:=True
End Sub
Private Sub UpdateHTML()
On Error GoTo ERRORHANDLER
Close
Open ThisWorkbook.Worksheets("Uhrzeit").Range("D2").Value & _
"\zeit.htm" For Output As #1
Print #1, "<html><body><font face=""Arial""><H1>"
Print #1, "Diese Datei wurde um " & Range("A1").Text & " Uhr gespeichert."
Print #1, "</H1></font></body></html>"
Close
Call StartHTML
Exit Sub
ERRORHANDLER:
MsgBox "Die Datei konnte nicht erstellt werden!"
Call StopHTML
End Sub
Sub StopHTML()
On Error Resume Next
Application.OnTime earliesttime:=gdNextTimeB, _
procedure:=gsMacroB, schedule:=False
End Sub
ClassModule: DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopClock
Call StopHTML
End Sub