Gruppe
Ereignis
Bereich
OnTime
Thema
Zeit eintragen und Tabelle minütlich als HTML-Datei speichern
Problem
Wie kann ich die Zeitangabe in einer Zelle und der Statusbar jede Sekunde aktualisieren und die Tabelle jede Minute als HTMLDatei speichern lassen?
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
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