Zeit eintragen und Tabelle minütlich als HTML-Datei speichern

Home Zurück Vor

Download der Beispiel-Arbeitsmappe

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