MS-Office-Forum

MS-Office-Forum (https://www.ms-office-forum.net/forum/index.php)
-   MOF-FAQ - Module/VBA/VBE (https://www.ms-office-forum.net/forum/forumdisplay.php?f=144)
-   -   Wie ermittle ich Zeitzonendaten (Sommerzeit etc.)? (https://www.ms-office-forum.net/forum/showthread.php?t=95658)

Stefan Kulpa 01.02.2003 05:03

Wie ermittle ich Zeitzonendaten (Sommerzeit etc.)?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Code:

Option Explicit
 
'// -------------------------------------------------------------------------------------
'// Dieser Codeausschnitt ermittelt verschiedene Zeitzoneninformationen und bedient sich
'// dabei des Win32-API. Folgende Funktionen stehen zur Verfügung:
'// -------------------------------------------------------------------------------------
'// Funktion:              Beschreibung:
'// -------------------------------------------------------------------------------------
'// DaylightSavingExists    Ermittelt, ob die Zeitzone (des Systems) eine Sommerzeit hat
'// DaylightSaving          Ermittelt, ob Sommerzeit besteht
'// StandardBias            Ermittelt die Sommerzeit-Zeitverschiebung gegenüber GMT-Uhrzeit in Minuten
'// DaylightBias            Ermittelt die die Standardzeit-Zeitverschiebung gegenüber GMT-Uhrzeit in Minuten
'// CurrentBias            Ermittelt die aktuelle Zeitverschiebung gegenüber GMT-Uhrzeit in Minuten
'// DaylightName            Ermittelt den Klartextnamen der Sommerzeit-Zeitzone
'// StandardName            Ermittelt den Klartextnamen der Standardzeit-Zeitzone
'// GMTTime                Ermittelt die aktuelle GMT-Uhrzeit (inkl. Datum)
'// FirstDateDaylight      Ermittelt das Startdatum der Sommerzeit
'// FirstDateStandard      Ermittelt das Startdatum der Standardzeit
'// -------------------------------------------------------------------------------------
 
Const TIME_ZONE_ID_DAYLIGHT As Long = 2
 
Type SYSTEMTIME
    wYear                  As Integer
    wMonth                As Integer
    wDayOfWeek            As Integer
    wDay                  As Integer
    wHour                  As Integer
    wMinute                As Integer
    wSecond                As Integer
    wMilliseconds          As Integer
End Type
 
Type TIME_ZONE_INFORMATION
    Bias                  As Long      ' Basis-Zeitverschiebung in Minuten
    StandardName(1 To 64)  As Byte      ' Name der Sommerzeit-Zeitzone
    StandardDate          As SYSTEMTIME ' Beginn der Standardzeit
    StandardBias          As Long      ' Zusätzliche Zeitverschiebung der Standardzeit
    DaylightName(1 To 64)  As Byte      ' Name der Sommerzeit-Zeitzone
    DaylightDate          As SYSTEMTIME ' Beginn der Sommerzeit
    DaylightBias          As Long      ' Zusätzliche Zeitverschiebung der Sommerzeit
End Type
 
Declare Function GetTimeZoneInformation Lib "kernel32" _
                (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
 
Sub Beispiel()
 
    Debug.Print "Aktuelle Zeit"
    Debug.Print "-------------"
    Debug.Print "Aktuelle Lokalzeit: "; Format$(Now(), "dd.mm.yyyy, hh:nn:ss U\hr")
    Debug.Print "Aktuelle GMT-Zeit: "; Format$(GMTTime(), "dd.mm.yyyy, hh:nn:ss U\hr")
    Debug.Print "Sommerzeit: "; IIf(DaylightSaving(), "Ja", "Nein")
    Debug.Print
    Debug.Print "Standardzeit"
    Debug.Print "------------"
    Debug.Print "Name der Standardzeit: "; StandardName()
    Debug.Print "Beginn der Standardzeit: "; Format$(FirstDateStandard(), "dd.mm.yyyy, hh:nn:ss U\hr")
    Debug.Print "Zeitverschiebung: "; "GMT" & IIf(StandardBias < 0, "", "+") & StandardBias & " Minuten"
    Debug.Print
    Debug.Print "Sommerzeit"
    Debug.Print "----------"
    If DaylightSavingExists = True Then
        Debug.Print "Name der Sommerzeit: "; DaylightName()
        Debug.Print "Beginn der Sommerzeit: "; Format$(FirstDateDaylight(), "dd.mm.yyyy, hh:nn:ss U\hr")
        Debug.Print "Zeitverschiebung: "; "GMT" & IIf(DaylightBias < 0, "", "+") & DaylightBias & " Minuten"
    Else
        Debug.Print vbTab; "Zeitzone hat keine Sommerzeit!"
    End If
'// -------------------------------------------------------------------------------------
'// Ausgabe:
'//
'// Aktuelle Zeit
'// -------------
'// Aktuelle Lokalzeit: 01.02.2003, 06:01:20 Uhr
'// Aktuelle GMT-Zeit: 01.02.2003, 05:01:20 Uhr
'// Sommerzeit: Nein
'//
'// Standardzeit
'// ------------
'// Name der Standardzeit: Westeuropäische Normalzeit
'// Beginn der Standardzeit: 26.10.2003, 03:00:00 Uhr
'// Zeitverschiebung: GMT+60 Minuten
'//
'// Sommerzeit
'// ----------
'// Name der Sommerzeit: Westeuropäische Sommerzeit
'// Beginn der Sommerzeit: 30.03.2003, 02:00:00 Uhr
'// Zeitverschiebung: GMT+120 Minuten
'// -------------------------------------------------------------------------------------
 
End Sub
 
Function DaylightSavingExists() As Boolean
'// Gibt zurück, ob die Zeitzone eine Sommerzeit hat.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim RetVal As Long
    RetVal = GetTimeZoneInformation(udtTZI)
    DaylightSavingExists = (udtTZI.DaylightDate.wMonth <> 0)
 
End Function
 
Function DaylightSaving() As Boolean
'// Gibt zurück, ob Sommerzeit besteht.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim RetVal As Long
    RetVal = GetTimeZoneInformation(udtTZI)
    DaylightSaving = (RetVal = TIME_ZONE_ID_DAYLIGHT)
 
End Function
 
Function StandardBias() As Integer
'// Gibt die Standardzeit-Zeitverschiebung
'// gegenüber GMT-Uhrzeit in Minuten zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    GetTimeZoneInformation udtTZI
    StandardBias = -(udtTZI.Bias + udtTZI.StandardBias)
 
End Function
 
Function DaylightBias() As Integer
'// Gibt die Sommerzeit-Zeitverschiebung
'// gegenüber GMT-Uhrzeit in Minuten zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    GetTimeZoneInformation udtTZI
    DaylightBias = -(udtTZI.Bias + udtTZI.DaylightBias)
 
End Function
 
Function CurrentBias() As Integer
'// Gibt die aktuelle Zeitverschiebung
'// gegenüber GMT-Uhrzeit in Minuten zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim RetVal As Long
    RetVal = GetTimeZoneInformation(udtTZI)
    With udtTZI
        If RetVal = TIME_ZONE_ID_DAYLIGHT Then
              CurrentBias = -(.Bias + .DaylightBias)
        Else: CurrentBias = -(.Bias + .StandardBias)
        End If
    End With
 
End Function
 
Function DaylightName() As String
'// Gibt den Klartextnamen der Sommerzeit-Zeitzone zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    Dim lNullPos As Integer
    GetTimeZoneInformation udtTZI
    With udtTZI
        If InStr(.DaylightName, vbNullChar) > 0 Then
              DaylightName = Left$(.DaylightName, InStr(.DaylightName, vbNullChar) - 1)
        Else: DaylightName = .DaylightName
        End If
    End With
 
End Function
 
Function StandardName() As String
'// Gibt den Klartextnamen der Standardzeit-Zeitzone zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    GetTimeZoneInformation udtTZI
    With udtTZI
        If InStr(.StandardName, vbNullChar) > 0 Then
              StandardName = Left$(.StandardName, InStr(.StandardName, vbNullChar) - 1)
        Else: StandardName = .StandardName
        End If
    End With
 
End Function
 
Function GMTTime() As Date
'// Gibt die aktuelle GMT-Uhrzeit (inkl. Datum) zurück.
    GMTTime = DateAdd("n", -CurrentBias(), Now)
 
End Function
 
Function FirstDateDaylight(Optional ByVal InYear As Long) As Date
'// Gibt das Startdatum der Sommerzeit zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    If InYear = 0 Then InYear = Year(Now)
    GetTimeZoneInformation udtTZI
    FirstDateDaylight = GetTimezoneChangeDate(udtTZI.DaylightDate, InYear)
 
End Function
 
Public Function FirstDateStandard(Optional ByVal InYear As Long) As Date
'// Gibt das Startdatum der Standardzeit zurück.
    Dim udtTZI As TIME_ZONE_INFORMATION
    If InYear = 0 Then InYear = Year(Now)
    GetTimeZoneInformation udtTZI
    FirstDateStandard = GetTimezoneChangeDate(udtTZI.StandardDate, InYear)
 
End Function
 
Function GetTimezoneChangeDate(Data As SYSTEMTIME, InYear As Long) As Date
    Dim dtTemp              As Date
    Dim lMonthFirstWeekday  As Long
'// In Data.wDayOfWeek wird ein Wochentag übergeben. Die Information in .wDay
'// legt fest, in welcher Woche des Monats der betroffene Tag zu ermitteln
'// ist (1-4) bzw., dass der letzte gleiche Wochentag des Monats gemeint ist.
    With Data
        Select Case .wDay '// Gibt die Woche im Monat an
            Case 1 To'// Wochentag in 1.-4. Woche im Monat
            '// Wochentag des ersten Tages im Monat berechnen
                lMonthFirstWeekday = Weekday(DateSerial(InYear, .wMonth, 1))
            '// Den gesuchten Tag ermitteln
                GetTimezoneChangeDate = _
                    DateSerial(InYear, .wMonth, _
                              .wDayOfWeek - lMonthFirstWeekday + .wDay * 7 + 1) + _
                              TimeSerial(.wHour, .wMinute, .wSecond)
            Case 5                                    ' letzter Wochentag im Monat
            '// Letzten Tag des Monats berechnen
                dtTemp = DateSerial(InYear, .wMonth + 1, 0)
            '// Zum letzten passenden Wochentag dieses Monats rechnen
                GetTimezoneChangeDate = _
                    dtTemp + vbSunday - Weekday(dtTemp) + _
                    TimeSerial(.wHour, .wMinute, .wSecond)
        End Select
    End With
 
End Function

Code eingefügt mit dem MOF Code Converter

eddie 11.12.2006 12:26

Zeitzoneninformationen aller Zeitzonen auslesen
 
Danke für den Skript.

Ich habe aber noch eine Frage:
Soviel ich hier herauslese kann man nur die Daten für die dzt. eingestellte Zeitzone herauslesen.

Gibt es eine Möglichkeit, die Daten ALLER Zeitzonen auszulesen?

Da man ja die Zeitzone nachträglich ändern kann, müssen die Informationen irgendwo abgespeichert sein. Eventuell kann man diese Auslesen und in eine Tabelle abstellen.

JuMathias 14.08.2017 15:40

Hallo Stefan, hallo Eddie,

ich habe euren VBA schon einmal in eine XLSM-Datei gebracht und es erscheint beim debuggen die Fehlermeldung:

"Ein öffentlicher benutzter Typ kann nicht innerhalb eines Objektmoduls definiert werden"

und


"Type SYSTEMTIME" ist blau markiert.

Wo liegt da mein Problem?

Gruß

JuMathias


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:56 Uhr.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.