Option Explicit
'!!!!! Z E I T Z O N E in Stunden angeben !!!!!!!!!!!!!!!!
'!!!!!
'z.B. GMT +1
Const c_ZEITVERSCHIEBUNG_ZU_GMT_IN_STUNDEN As Double = 1
'!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Const c_ZEITVERSCHIEBUNG_ZU_GMT_IN_SEKUNDEN As Long = _
c_ZEITVERSCHIEBUNG_ZU_GMT_IN_STUNDEN * 3600
'***************************************************************
Sub SelektierteZellenMitUTCTimestampInExcelDatum()
->
->Wandelt den in einer Zelle enthaltenen UTC-Timestamp
->in eine Excel-Datums/Zeitangabe (dd.mm.yyyy hh:nn:ss)
->1000stel Sekunden werden abgeschnitten
->
->Die Umwandlung wird für alle selektierten Zellen durchgeführt
Dim Zelle As Range, r As Range, l_Anz As Long, l_AnzGesamt As Long
->Selection auf benutzten Bereich beschränken
Set r = Intersect(Selection, ActiveSheet.UsedRange)
r.Select
l_AnzGesamt = r.Count
l_Anz = 0
For Each Zelle In r
->Fortschritt anzeigen
l_Anz = l_Anz + 1
If (l_Anz Mod 100) = 1 Then Application.StatusBar = l_AnzGesamt & / & l_Anz
If Zelle.Value <> Then
If Not Umwandlung_ZelleMitUTCTimestampInExcelDatum(Zelle) Then
Zelle.Select
MsgBox ( _
Es ist bei der Umwandlung ein Fehler aufgetreten & vbLf & vbLf & _
Die Zelle & Zelle.Address & konnte nicht umgewandelt werden.)
Exit For
End If
End If
Next
Application.StatusBar =
Set Zelle = Nothing: Set r = Nothing
End Sub
'***************************************************************
Private Function Umwandlung_ZelleMitUTCTimestampInExcelDatum(Zelle As Range) As Boolean
->Wandelt den in einer Zelle enthaltenen UTC-Timestamp
->in eine Excel-Datums/Zeitangabe (dd.mm.yyyy hh:nn:ss)
->
->1000stel Sekunden werden abgeschnitten
->UTC-Format:
->mit 1000stel Sekunden: 1119307449.652
->Bezug: Sekunden seit 1.1.1970 00:00:00:000
->entspricht 20. Juni 2005 22:44:09
->Excel-Datum:
->Aus der Microsoft-Hilfe:
->Variablen vom Datentyp Date werden als 64-Bit-Gleitkommazahlen (8 Bytes)
->nach IEEE gespeichert und können ein
->Datum im Bereich vom 01. Januar 100 bis zum 31. Dezember 9999 und
->eine Uhrzeit im Bereich von 0:00:00 bis 23:59:59 speichern.
->Jeder gültige Wert eines Datums- oder Zeitliterals kann einer Variablen
->vom Datentyp Date zugewiesen werden.
->Ein Datumsliteral muß durch das Zeichen (#) eingeschlossen sein,
->zum Beispiel: #January 1, 1993# oder #1 Jan 93#.
->Variablen vom Datentyp Date verwenden zur Darstellung des Datums
->das auf dem Computer eingestellte kurze Datumsformat.
->Zeitangaben werden mit dem auf dem Computer eingestellten Zeitformat
->(entweder 12- oder 24-Stunden) dargestellt.
->Beim Umwandeln anderer numerischer Datentypen in Werte des Datentyps Date
->repräsentieren die Vorkommastellen das Datum und die Nachkommastellen die Uhrzeit.
->Mitternacht entspricht dem Wert 0, und Mittag entspricht den Nachkommawert 0,5.
->Negative ganze Zahlen repräsentieren ein Datum vor dem 30. Dezember 1899.
->Der 1.1.1970 00:00:00 entspricht 25569 Tage seit 30. Dezember 1899
Const c_AnzTage_30122005bis01011970 = 25569
Const c_SekundenProTag As Long = 86400
Dim s_UTCZeit As String
Dim l_UTC_Sekunden As Long ->UTC-Zahl ohne 1000stel sec
Dim l_UTC_AnzTage As Long 'Tage in der UTC-Zeit
Dim l_UTC_Sekunden_Uhrzeit As Long ->Tageszeit in sec in der UTC-Zeit
Dim d_date_Excel As Double ->Excel-Datum
Dim pos As Long
Dim d_Datum As Date
->Fehlerkennung setzen
Umwandlung_ZelleMitUTCTimestampInExcelDatum = False
->Nur eine Zelle im Übergabe-Range zulässig
If Zelle.Count > 1 Then Exit Function
->UTCZeit holen
s_UTCZeit = Zelle.Value
->ggf tausendstel Sekunden abschneiden
pos = InStr(s_UTCZeit, .)
If pos <> 0 Then s_UTCZeit = Left(s_UTCZeit, pos - 1)
->auf Zahl prüfen
On Error Resume Next
l_UTC_Sekunden = s_UTCZeit
If Err.Number <> 0 Then
MsgBox (UTC-Zeit enthält unzulässige Zeichen)
Exit Function
End If
On Error GoTo 0
->GMT-Zeitzone berücksichtigen
On Error Resume Next
l_UTC_Sekunden = l_UTC_Sekunden + c_ZEITVERSCHIEBUNG_ZU_GMT_IN_SEKUNDEN
If Err.Number <> 0 Then
MsgBox (UTC-Sekunden-Überlauf)
Exit Function
End If
On Error GoTo 0
->prüfen vor 1.1.1970
If l_UTC_Sekunden > 0 Then
-> b) Aus der UTC-Zeit sind die Anzahl Tage seit 1.1.1970 bestimmen
l_UTC_AnzTage = l_UTC_Sekunden \ c_SekundenProTag
-> c) der Rest ist die Uhrzeit in Sekunden
l_UTC_Sekunden_Uhrzeit = l_UTC_Sekunden - (l_UTC_AnzTage * c_SekundenProTag)
-> d) Excel Datum/Uhrzeit bilden
d_date_Excel = c_AnzTage_30122005bis01011970 + _
l_UTC_AnzTage + (l_UTC_Sekunden_Uhrzeit / c_SekundenProTag)
Else
-> b) Aus der UTC-Zeit sind die Anzahl Tage seit 1.1.1970 bestimmen
->genau die Tagesgrenze ?
If (l_UTC_Sekunden Mod c_SekundenProTag) = 0 Then
l_UTC_AnzTage = (-1 * (l_UTC_Sekunden \ c_SekundenProTag))
Else
l_UTC_AnzTage = (-1 * (l_UTC_Sekunden \ c_SekundenProTag)) + 1
End If
-> c) der Rest ist die Uhrzeit in Sekunden
l_UTC_Sekunden_Uhrzeit = l_UTC_Sekunden + (l_UTC_AnzTage * c_SekundenProTag)
-> d) Excel Datum/Uhrzeit bilden
d_date_Excel = c_AnzTage_30122005bis01011970 - _
l_UTC_AnzTage + (l_UTC_Sekunden_Uhrzeit / c_SekundenProTag)
End If
->Datum speichern
->Zelle als Datum formatieren
Zelle.NumberFormat = dd.mm.yyyy hh:mm:ss
d_Datum = d_date_Excel '### Korrektur 13.2.2006
'Notwendig, da Excel hier
'die Korrektur bzgl. der
'Datumskorrektur 1900/1904
'durchführt
Zelle.Value = d_Datum
->Fehlerkennung setzen
Umwandlung_ZelleMitUTCTimestampInExcelDatum = True
End Function
'***************************************************************
Sub SelektierteZelleMitExcelDatumInUTCTimestamp()
->
->Wandelt das in einer Zelle enthaltene Excel-Datum
->in einen UTC-Timestamp
->
->Die Umwandlung wird für alle selektierten Zellen durchgeführt
Dim Zelle As Range, r As Range, l_Anz As Long, l_AnzGesamt As Long
->Selection auf benutzten Bereich beschränken
Set r = Intersect(Selection, ActiveSheet.UsedRange)
r.Select
l_AnzGesamt = r.Count
l_Anz = 0
For Each Zelle In r
If Zelle.Value <> Then
->Fortschritt anzeigen
l_Anz = l_Anz + 1
If (l_Anz Mod 100) = 1 Then Application.StatusBar = l_AnzGesamt & / & l_Anz
If Not Umwandlung_ZelleMitExcelDatumInUTCTimestamp(Zelle) Then
Zelle.Select
MsgBox ( _
Es ist bei der Umwandlung ein Fehler aufgetreten & vbLf & vbLf & _
Die Zelle & Zelle.Address & konnte nicht umgewandelt werden.)
Exit For
End If
End If
Next
Application.StatusBar =
Set Zelle = Nothing: Set r = Nothing
End Sub
'*************************************************************
Private Function Umwandlung_ZelleMitExcelDatumInUTCTimestamp(Zelle As Range) As Boolean
Const c_AnzTage_30122005bis01011970 = 25569
Const c_SekundenProTag As Long = 86400
Dim s_UTCZeit As String
Dim l_UTCZeit As Long
Dim d_date_Excel As Double
Dim l_Excel_AnzTage As Long
Dim l_Excel_Zeit As Long
Dim l_ZeitInSekunden As Long
Dim pos As Long
->Fehlerkennung setzen
Umwandlung_ZelleMitExcelDatumInUTCTimestamp = False
->Nur eine Zelle im Übergabe-Range zulässig
If Zelle.Count > 1 Then Exit Function
->auf Datum prüfen
If Not IsDate(Zelle.Value) Then Exit Function
->Excel-Datum holen
d_date_Excel = Zelle.Value
->Excel Tage
l_Excel_AnzTage = d_date_Excel \ 1
->Excel Zeit
d_date_Excel = d_date_Excel - l_Excel_AnzTage
->Tageszeit in Sekunden
l_ZeitInSekunden = d_date_Excel * c_SekundenProTag
->GMT-Zeitzone berücksichtigen
l_ZeitInSekunden = l_ZeitInSekunden - c_ZEITVERSCHIEBUNG_ZU_GMT_IN_SEKUNDEN
->prüfen vor 1.1.1970
If l_Excel_AnzTage >= c_AnzTage_30122005bis01011970 Then
s_UTCZeit = _
((l_Excel_AnzTage - c_AnzTage_30122005bis01011970) * c_SekundenProTag) + l_ZeitInSekunden
Else
l_UTCZeit = _
((l_Excel_AnzTage - c_AnzTage_30122005bis01011970) * c_SekundenProTag)
If l_ZeitInSekunden <> 0 Then l_UTCZeit = l_UTCZeit + l_ZeitInSekunden
s_UTCZeit = l_UTCZeit
End If
->UTC speichern
->Zelle als String formatieren
Zelle.NumberFormat = @
Zelle.Value = s_UTCZeit
->Fehlerkennung setzen
Umwandlung_ZelleMitExcelDatumInUTCTimestamp = True
End Function
'*************************************************************
Sub Test_UTCTimestampInExcelDatumUndUmgekehrt()
Dim wb As Workbook, ws As Worksheet
Dim x As Long, c As Long, d_date As Date
Set wb = ActiveWorkbook: Set ws = wb.Worksheets.Add
ws.Columns(1).NumberFormat = dd.mm.yyyy hh:mm:ss
ws.Cells(1, 1).Value = Datum
ws.Cells(1, 1).Font.Bold = True
ws.Columns(2).NumberFormat = dd.mm.yyyy hh:mm:ss
ws.Cells(1, 2).Value = UTC-Timestamp
ws.Cells(1, 2).Font.Bold = True
ws.Columns(3).NumberFormat = dd.mm.yyyy hh:mm:ss
ws.Cells(1, 3).Value = Kontroll-Datum
ws.Cells(1, 3).Font.Bold = True
->Datum für Test in die Spalten 1 -3
For c = 1 To 3: d_date = 01.01.1970 00:00:00: ws.Cells(2, c).Value = d_date: Next
For c = 1 To 3: d_date = 31.12.2005 23:59:59: ws.Cells(3, c).Value = d_date: Next
For c = 1 To 3: d_date = 31.12.2005 00:00:00: ws.Cells(4, c).Value = d_date: Next
For c = 1 To 3: d_date = 31.12.2005 00:00:01: ws.Cells(5, c).Value = d_date: Next
For c = 1 To 3: d_date = 31.12.1969 23:59:59: ws.Cells(6, c).Value = d_date: Next
For c = 1 To 3: d_date = 01.01.1969 00:00:00: ws.Cells(7, c).Value = d_date: Next
For c = 1 To 3: d_date = 01.01.1969 00:00:01: ws.Cells(8, c).Value = d_date: Next
For c = 1 To 3: d_date = 01.01.1990 00:00:00: ws.Cells(9, c).Value = d_date: Next
For c = 1 To 3: d_date = 01.01.2006 01:05:05: ws.Cells(10, c).Value = d_date: Next
For c = 1 To 3: d_date = 01.01.1970 01:00:00: ws.Cells(11, c).Value = d_date: Next
For c = 1 To 3: d_date = 01.01.1902 01:05:05: ws.Cells(12, c).Value = d_date: Next
For c = 1 To 3: ws.Columns(c).AutoFit: Next
->zweite Spalte in UTC wandeln
ws.Range(ws.Cells(2, 2), ws.Cells(12, 2)).Select
Call SelektierteZelleMitExcelDatumInUTCTimestamp
->dritte Spalte in UTC wandeln
ws.Range(ws.Cells(2, 3), ws.Cells(12, 3)).Select
Call SelektierteZelleMitExcelDatumInUTCTimestamp
->dritte Spalte in Excel-Datum wandeln
ws.Range(ws.Cells(2, 3), ws.Cells(12, 3)).Select
Call SelektierteZellenMitUTCTimestampInExcelDatum
AUFRAEUMEN:
Set ws = Nothing: Set wb = Nothing
End Sub
