VBA - KALENDER-FUNKTIONEN

Public Function DATEI_DATUM(DateiName As String) As Date
' liefert Datum/Zeit des letztmaligen öffnens einer Datei
DATEI_DATUM = FileDateTime(DateiName)
End Function

Public Function DATUM_JA(WDat As Variant) As String
' gibt JA zurück, falls Typ = Datum, sonst NEIN
If IsDate(WDat) Then DATUM_JA = "JA" Else DATUM_JA = "NEIN"
End Function

Public Function JAHRESZEIT(Optional WMonat As Variant) As String
If IsMissing(WMonat) Then ' wenn Parameter übergeben wurde
    WMonat = Month(Date) ' Zuweisung des aktuellen Monats
Else
    WMonat = Month(WMonat) ' Zuweisung des übergebenen Monats
End If
Select Case WMonat ' Monatsfälle abklären
        Case 3, 4, 5
            JAHRESZEIT = "Frühling"
    Case 6, 7, 8
        JAHRESZEIT = "Sommer"
    Case 9, 10, 11
        JAHRESZEIT = "Herbst"
    Case 12, 1, 2
        JAHRESZEIT = "Winter"
End Select
End Function

Public Function STD_MIN_SEK(WSTD As Integer, Optional WMIN, Optional WSEK) As Date
' Übergabe von Stunden, Minuten, Sekunden als Zahl
' Rückgabe von Zeitvariablen
If IsMissing(WMIN) Then WMIN = 0
If IsMissing(WSEK) Then WSEK = 0
 STD_MIN_SEK = TimeSerial(WSTD, WMIN, WSEK)
End Function

Public Function HEUTE() As Date
' gibt aktuelles Datum und Uhrzeit zurück
HEUTE = Now()
End Function

Public Function TAGESNAME(WDatum As Date) As String
Dim TAG As Integer
TAG = WeekDay(WDatum)
Select Case TAG
    Case 1
        TAGESNAME = "Sonntag"
    Case 2
        TAGESNAME = "Montag"
    Case 3
        TAGESNAME = "Dienstag"
    Case 4
        TAGESNAME = "Mittwoch"
    Case 5
        TAGESNAME = "Donnerstag"
    Case 6
        TAGESNAME = "Freitag"
    Case 7
        TAGESNAME = "Samstag"
End Select
End Function

Public Function QUARTAL(WDatum As Date) As String
QUARTAL = Int(Month(WDatum) / 3 + 0.99)
End Function

Public Function HALBJAHR(WDatum As Date) As String
HALBJAHR = Int(Month(WDatum) / 6 + 0.99)
End Function


Public Function JAHRZEHNT(WDatum As Date) As String
JAHRZEHNT = Int(Year(WDatum) / 10 + 0.99)
End Function

Public Function JAHRHUNDERT(WDatum As Date) As String
JAHRHUNDERT = Int(Year(WDatum) / 100 + 0.99)
End Function

Public Function JAHRTAUSEND(WDatum As Date) As String
JAHRTAUSEND = Int(Year(WDatum) / 1000 + 0.99)
End Function

Public Function DATUM_WEITER(WTyp As String, WAnz As Integer, _
WDatum As Date) As Date
' Weiterrechnen von Datumswerten in vorgegebenen Einheiten
' z.B.: DATUM_WEITER("MONAT",2,"16.01.15")
' rechnet 2 Monate ab 16.01.15 weiter
Select Case WTyp ' Typen-Fall-Unterscheidung
    Case "JAHR", "J"
        DATUM_WEITER = DateAdd("yyyy", WAnz, WDatum)
    Case "QUARTAL", "Q"
        DATUM_WEITER = DateAdd("q", WAnz, WDatum)
    Case "MONAT", "MON", "M"
        DATUM_WEITER = DateAdd("m", WAnz, WDatum)
    Case "JAHRESTAG", "JT"
        DATUM_WEITER = DateAdd("y", WAnz, WDatum)
    Case "TAG", "T", "TG", "TAGE"
        DATUM_WEITER = DateAdd("d", WAnz, WDatum)
    Case "WOCHENTAG", "WT"
        DATUM_WEITER = DateAdd("w", WAnz, WDatum)
    Case "WOCHE", "W", "WO", "WOCHEN"
        DATUM_WEITER = DateAdd("ww", WAnz, WDatum)
    Case "STUNDE", "S", "STD"
        DATUM_WEITER = DateAdd("h", WAnz, WDatum)
    Case "MINUTE", "MIN"
        DATUM_WEITER = DateAdd("n", WAnz, WDatum)
    Case "SEKUNDE", "S", "SEK"
        DATUM_WEITER = DateAdd("s", WAnz, WDatum)
End Select
End Function

Public Function DATUM_DIFFERENZ(WDatum1 As Date, WDatum2 As Date, _
Optional WTyp As Variant) As Integer
' liefert Diffenrenz in Typeneinheit als Zahl zurück
' z.B. Tages-Differenz bei DATUM_DIFFERENZ("01.05.16","05.06.15","TAG")
Dim DTyp As String
DTyp = IIf(Not IsMissing(WTyp), WTyp, "TAG")
Select Case DTyp
    Case "JAHR", "J"
        DATUM_DIFFERENZ = DateDiff("yyyy", WDatum1, WDatum2)
    Case "QUARTAL", "Q"
        DATUM_DIFFERENZ = DateDiff("q", WDatum1, WDatum2)
    Case "MONAT", "MON"
        DATUM_DIFFERENZ = DateDiff("m", WDatum1, WDatum2)
    Case "JAHRESTAG", "JT"
        DATUM_DIFFERENZ = DateDiff("y", WDatum1, WDatum2)
    Case "TAG", "T", "TG"
        DATUM_DIFFERENZ = DateDiff("d", WDatum1, WDatum2)
    Case "WOCHENTAG", "WT"
        DATUM_DIFFERENZ = DateDiff("w", WDatum1, WDatum2)
    Case "WOCHE", "W", "WO"
        DATUM_DIFFERENZ = DateDiff("ww", WDatum1, WDatum2)
    Case "STUNDE", "S", "STD"
        DATUM_DIFFERENZ = DateDiff("h", WDatum1, WDatum2)
    Case "MINUTE", "MIN"
        DATUM_DIFFERENZ = DateDiff("n", WDatum1, WDatum2)
    Case "SEKUNDE", "S", "SEK"
        DATUM_DIFFERENZ = DateDiff("s", WDatum1, WDatum2)
End Select
End Function

Public Function MONATSNAME(WDatum As Date) As String
Dim MONAT As Integer
MONAT = Month(WDatum)
Select Case MONAT
    Case 1
        MONATSNAME = "Januar"
    Case 2
        MONATSNAME = "Februar"
    Case 3
        MONATSNAME = "März"
    Case 4
        MONATSNAME = "April"
    Case 5
        MONATSNAME = "Mai"
    Case 6
        MONATSNAME = "Juni"
     Case 7
        MONATSNAME = "Juli"
    Case 8
        MONATSNAME = "August"
    Case 9
        MONATSNAME = "September"
    Case 10
        MONATSNAME = "Oktober"
    Case 11
        MONATSNAME = "November"
    Case 12
        MONATSNAME = "Dezember"
End Select
End Function

Public Function ZEIT(Optional WZeit As Variant) As Date
If IsMissing(WZeit) Then
    ZEIT = Time()
Else
    ZEIT = Time(WZeit)
End If
End Function

Public Function TAG(Optional WDatum As Date) As Integer
If IsMissing(WDatum) Then
    TAG = Day(Date)
Else
    TAG = Day(WDatum)
End If
End Function

Public Function MONAT(Optional WDatum As Variant) As Integer
If IsMissing(WDatum) Then
    MONAT = Month(Date)
Else
    MONAT = Month(WDatum)
End If
End Function

Public Function JAHR(Optional WDatum As Variant) As Integer
If IsMissing(WDatum) Then
    JAHR = Year(Date)
Else
    JAHR = Year(WDatum)
End If
End Function

Public Function STUNDE(Optional WZeit As Variant) As Integer
If IsMissing(WZeit) Then
    STUNDE = Hour(Time())
Else
    STUNDE = Hour(WZeit)
End If
End Function

Public Function SEKUNDE(Optional WZeit As Variant) As Integer
If IsMissing(WZeit) Then
    SEKUNDE = Second(Time())
Else
    SEKUNDE = Second(WZeit)
End If
End Function