MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - MOF-FAQ > MOF-FAQ - Module/VBA/VBE
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 01.02.2003, 06:03   #1
Stefan Kulpa
MS-Office-Forum Team MS-Office-Forum Team
Normal Wie ermittle ich Zeitzonendaten (Sommerzeit etc.)?

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 4   '// 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
Angehängte Dateien
Dateityp: txt zeitzone.txt (9,1 KB, 917x aufgerufen)

__________________

Stefan

Geändert von Stefan Kulpa (01.02.2003 um 06:30 Uhr).
Stefan Kulpa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.12.2006, 13:26   #2
eddie
MOF User
MOF User
Standard 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.

__________________

Gruß
Eddie

Win7®, Office2010®, Visual Studio 2010 (VB; C#)®
eddie ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.08.2017, 16:40   #3
JuMathias
MOF Profi
MOF Profi
Standard

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
JuMathias ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 07:26 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

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

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.