Die Klasse hat einige spezielle Attribute. Sie muss darum über den Modulbrowser→Import importiert werden, damit die Attribute aktiv sind.

dateinterval.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "DateInterval"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : DateInterval.cls
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/
'Environment  : VBA 2007+
'Version      : 1.6.0
'Name         : DateInterval
'Author       : Stefan Erb (ERS)
'History      : 06.08.2014 - ERS - Creation
'               26.08.2015 - ERS - Paramter iOnlyAddReturnDateInterval auf iByRef umbenannt
'               04.01.2016 - ERS - format2() eingebaut um Texte einfacher parsen zu können
'               02.03.2016 - ERS - addTo() hinzugefügt
'               30.03.2016 - ERS - testIntervalString() hinzugefügt
'               21.06.2016 - ERS - Add Interface IFormattable
'-------------------------------------------------------------------------------
Option Explicit
 
'-------------------------------------------------------------------------------
' -- ! SETTINGS !
'-------------------------------------------------------------------------------
'In Excel funktionieren Events nicht. Auch der NZ() gibt es dort nicht.
'Darum hier angeben ob es sich um MS Access handelt oder eben nicht. Leider gibts datzu keine Systemvariable
#Const isAccess = True
 
'Das Interface IFormattable ist in diesem Projekt vorhanden
#Const IFormattable_exists = True
 
'Die IntervalSpec entspricht fast der IntervalSpec von PHP: http://php.net/manual/de/dateinterval.construct.php
'Dies enrspricht der ISO8601 Duration Definition  http://en.wikipedia.org/wiki/Iso8601#Durations
'Durations are a component of time intervals and define the amount of intervening time in a time interval.
'They should only be used as part of a time interval as prescribed by the standard. Time intervals are discussed in the next section.
'
'Durations are represented by the format P[n]Y[n]M[n]DT[n]H[n]M[n]S or P[n]W as shown to the right. In these representations,
'the [n] is replaced by the value for each of the date and time elements that follow the [n]. Leading zeros are not required,
'but the maximum number of digits for each element should be agreed to by the communicating parties. '
'The capital letters P, Y, M, W, D, T, H, M, and S are designators for each of the date and time elements and are not replaced.
'
'    P is the duration designator (historically called "period") placed at the start of the duration representation.
'    Y is the year designator that follows the value for the number of years.
'    M is the month designator that follows the value for the number of months.
'    W is the week designator that follows the value for the number of weeks.
'    D is the day designator that follows the value for the number of days.
'    T is the time designator that precedes the time components of the representation.
'    H is the hour designator that follows the value for the number of hours.
'    M is the minute designator that follows the value for the number of minutes.
'    S is the second designator that follows the value for the number of seconds.
'
'For example, "P3Y6M4DT12H30M5S" represents a duration of "three years, six months, four days, twelve hours, thirty minutes, and five seconds".
'Date and time elements including their designator may be omitted if their value is zero, and lower order elements may also be omitted for reduced precision.
'For example, "P23DT23H" and "P4Y" are both acceptable duration representations.
'To resolve ambiguity, "P1M" is a one-month duration and "PT1M" is a one-minute duration (note the time designator, T, that precedes the time value).
'The smallest value used may also have a decimal fraction, as in "P0.5Y" to indicate half a year. This decimal fraction may be specified with either a comma or a full stop,
'as in "P0,5Y" or "P0.5Y". The standard does not prohibit date and time values in a duration representation from exceeding their "carry over points" except as noted below.
'Thus, "PT36H" could be used as well as "P1DT12H" for representing the same duration.
'Alternatively, a format for duration based on combined date and time representations may be used by agreement between the communicating parties either in the
'basic format PYYYYMMDDThhmmss or in the extended format P[YYYY]-[MM]-[DD]T[hh]:[mm]:[ss]. For example, the first duration shown above would be "P0003-06-04T12:30:05".
'However, individual date and time values cannot exceed their moduli (e.g. a value of 13 for the month or 25 for the hour would not be permissible).[16]
'
'Ich habe das ganze noch zusätzlich um die Nanosecond erweitert. F
'
 
#If IFormattable_exists Then
    Implements IFormattable
#End If
 
'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------
 
'/**
' * Die verschiedenen Teile
' */
'Die Einzelnen Teile des Intervals. Alle zusammengezählt ergibt den Gesammtinterval
Private pYear As Integer
Private pMonth As Integer
Private pDay As Integer
Private pHour As Integer
Private pMinute As Integer
Private pSecond As Integer
Private pNanoSecond As Long
Private pWeekDays As Long
Private pWeeks As Long
 
'Den Summen auf verschiedenen Basis. Wird nur bei DateDiff abgefüllt
'Print DateInterval.instanceFromDateDiff(#8/8/2014#, #8/10/2014#).seconds -> 172800 Sekunden
Private pYears As Variant
Private pMonths As Variant
Private pDays As Variant
Private pHours As Variant
Private pMinutes As Variant
Private pSeconds As Variant
Private pSign As Integer
 
'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Erstellt eine neue Instance
' * @param  String/Integer  Eine IntervalSpec oder Anzahl Tage
' * @return DateInterval
' */
Public Function instance(Optional ByVal iIntervalSpec As Variant = Empty) As DateInterval
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
 
    Set instance = New DateInterval: instance.construct iIntervalSpec
End Function
 
' /**
' * Initialisiert die Klasse
' * @param  String/Integer  Eine IntervalSpec oder Anzahl Tage
' * @return DateInterval
' */
Public Function construct(ByVal iIntervalSpec As Variant) As DateInterval
    Dim sm As Object
    clear
    If TypeName(iIntervalSpec) = "DateInterval" Then iIntervalSpec = iIntervalSpec.intervalSPec
 
    If rxIntervalSpec1.test(iIntervalSpec) Then
        'P[n]Y[n]M[n]W[n]DT[n]H[n]M[n]S[n]F
        Set sm = rxIntervalSpec1.execute(iIntervalSpec)(0).subMatches
        sign = IIf(sm(0) = Empty, 1, -1)
        pYear = sm(1)
        pMonth = sm(2)
        'Weeks werden in Days gewandelt
        pDay = sm(3) * 7 + sm(4)
        pHour = sm(5)
        pMinute = sm(6)
        pSecond = sm(7)
        pNanoSecond = sm(8)
    ElseIf rxIntervalSpec23.test(iIntervalSpec) Then
        'PYYYYMMDDThhmmss
        'P[YYYY]-[MM]-[DD]T[hh]:[mm]:[ss]
        Set sm = rxIntervalSpec23.execute(iIntervalSpec)(0).subMatches
        sign = IIf(sm(0) = Empty, 1, -1)
        pYear = sm(1)
        'sm(2) ist das Datumstrennzeichen
        pMonth = sm(3)
        pDay = sm(4)
        pHour = sm(5)
        's(6) ist das Zeittrennzeichen
        pMinute = sm(7)
        pSecond = sm(8)
        'sm(9) ist das Nanosekundentrennzeichen
        pNanoSecond = sm(10)
    ElseIf IsNumeric(iIntervalSpec) Then
        pDay = iIntervalSpec
    End If
 
    Set sm = Nothing
    Set construct = Me
End Function
 
'/**
' * Gibt die Differenz als DateInterval zu einem Datum zurück
' * @param  Date/String/DateTime
' * @param  Boolean
' * @return DateInterval
' */
Public Function instanceFromDateDiff( _
        Optional ByRef iDate1 As Variant = Null, _
        Optional ByRef iDate2 As Variant = Null, _
        Optional ByVal iAbsolute As Boolean = False _
) As DateInterval
    clear
    Set instanceFromDateDiff = New DateInterval
 
    Dim ns1 As Long, ns2 As Long        'NanoSecounds
    'Beine Eingabewerte zum Typ Date wandeln
    Dim dt1 As Date:        dt1 = getDate(iDate1, ns1)
    Dim dt2 As Date:        dt2 = getDate(iDate2, ns2)
    'Datum als Zahl inkl Nanosekunden
    'Normal: cdec(date) = [Tage].[Sekunden]
    'HIer umgerechnet zu [Tage][Sekunden].[Nanosekunden]
    Dim v1 As Variant:      v1 = CDec(dt1) * 10 ^ 10 + ns1 / 10 ^ 9
    Dim v2 As Variant:      v2 = CDec(dt2) * 10 ^ 10 + ns2 / 10 ^ 9
    'Den Kleineren als from, den Grösseren als To definieren
    Dim fromV As Variant:   fromV = least(v1, v2)
    Dim toV As Variant:     toV = greatest(v1, v2)
    'Davon je die Nanosekunden extrahieren
    Dim fromNs As Long:     fromNs = (fromV - Fix(fromV)) * 10 ^ 9
    Dim toNs As Long:       toNs = (toV - Fix(toV)) * 10 ^ 9
    'Dito mit dem Datum
    Dim fromD As Date:      fromD = CDate(Fix(fromV) / 10 ^ 10)
    Dim toD As Date:        toD = CDate(Fix(toV) / 10 ^ 10)
    'Differnez der Nanosekunden
    Dim diffNs As Long:     diffNs = toNs - fromNs
    'Jenchdem eine Sekundenkorrektur im toDate durchführen
    If diffNs < 0 Then toD = DateAdd("S", -1, toD)
 
    With instanceFromDateDiff
        'Die Differnezen in Totals mt DateDiff von VBA
        .years = DateDiff("YYYY", fromD, toD)
        .months = DateDiff("M", fromD, toD)
        .days = DateDiff("D", fromD, toD)
        .hours = DateDiff("H", fromD, toD)
        .minutes = DateDiff("N", fromD, toD)
        .seconds = DateDiff("S", fromD, toD)
 
        'Das VOrzeichen bestimmen
        .sign = IIf(iAbsolute, 1, Sgn(v1 - v2))
        'Die Differenz auf Datumteile aufgeteilt. Vm Grössten zum kleinsten. fromD wird jeweils um die extrahierte Grösse reduziert
        .year = diffPart(fromD, toD, "yyyy")
        .month = diffPart(fromD, toD, "M")
        .day = diffPart(fromD, toD, "D")
        .hour = diffPart(fromD, toD, "H")
        .minute = diffPart(fromD, toD, "N")
        .second = diffPart(fromD, toD, "S")
        .nanoSecond = IIf(Sgn(diffNs) < 0, 10 ^ 9 + diffNs, diffNs)
    End With
End Function
 
'/**
' * Erstellt eine Instanz aus einem einzelnen Parts
' * @example    Set di = DateInterval.instancePart("M", 3)
' * @param  String  YYMDHNS (auch I)
' * @param  Long    Wert
' * @return DateInterval
' */
Public Function instancePart(ByVal iShort As String, ByVal iValue As Long) As DateInterval
    clear
    Dim intSpec As String
    Select Case UCase(iShort)
        Case "YY", "YYYY":      intSpec = "P" & iValue & "Y"
        Case "M", "MM":         intSpec = "P" & iValue & "M"
        Case "D", "DD":         intSpec = "P" & iValue & "D"
        Case "H", "HH":         intSpec = "T" & iValue & "H"
        Case "N", "NN":         intSpec = "T" & iValue & "M"
        Case "S", "SS":         intSpec = "T" & iValue & "S"
'        Case "F", "FF":         intSpec = "P" & iValue & "Y"
    End Select
    Set instancePart = DateInterval.instance(intSpec)
End Function
 
'/**
' * Erstellt ein DateInterval aus Einzelwerten. Analog zu DateSerial und TimeSerial
' * @param  Variant         Jahre
' * @param  Integer         Monate
' * @param  Integer         Tage
' * @param  Integer         Stunden
' * @param  Integer         Minuten
' * @param  Integer         Sekunden
' * @param  Variant         Nanosekunden
' * @param  Boolean         true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateInterval
' */
Public Function serial( _
        Optional ByVal iYear As Variant = 0, _
        Optional ByVal iMonth As Integer = 0, _
        Optional ByVal iDay As Integer = 0, _
        Optional ByVal iHour As Integer = 0, _
        Optional ByVal iMinute As Integer = 0, _
        Optional ByVal iSecond As Integer = 0, _
        Optional ByVal iNanoSecond As Variant = 0, _
        Optional ByVal iByRef As Boolean = False _
) As DateInterval
    Dim di As New DateInterval
    If Not iByRef Then Set di = Me
    clear
    With di
        .year = NZ(iYear)
        .month = iMonth
        .day = iDay
        .hour = iHour
        .minute = iMinute
        .second = iSecond
        .nanoSecond = iNanoSecond
    End With
 
    Set serial = di
End Function
'/**
' * Formatiert den Interval. Bisher sind nur die folgenden Formate implementiert
' * m       Monat ohne führende Null (1-12)
' * mm      Monat mit führende Null (01-12)
' * mx      Total Anzahl Monate ohne führende Null
' * mmx     Total Anzahl Monate mit führende Null
' * d       Tag des Monats ohne führende Null (1-31)
' * dd      Tag des Monats mit führende Null (01-31)
' * dx      Total Anzahl Tage ohne führende Null
' * ddx     Total Anzahl Tage mit führende Null
' * y       Einstelliges Jahr. Analog zu d wird es glösser geschrieben, wenn es mehr Zeichen hat
' * yy      Zweistelliges Jahr
' * yyyy    Vierstelliges Jahr
' * h       Stunden ohne führende Null(0-24)
' * hh      Stunden mit führende Null(00-24)
' * hx      Total Anzahl Stunden ohne führende Null
' * hhx     Total Anzahl Stunden mit führende Null
' * n       Minuten ohne führende Null(0-59)
' * nn      Minuten mit führende Null(00-59)
' * nx      Total Anzahl Minuten ohne führende Null
' * nnx     Total Anzahl Minuten mit führende Null
' * s       Sekunden ohne führende Null(0-59)
' * ss      Sekunden mit führende Null(00-59)
' * sx      Total Anzahl Sekunden ohne führende Null
' * ssx     Total Anzahl Sekunden mit führende Null
' * r       Bei Muinus ein -
' * R       Bei Minus ein -, bei Plus ein +
' *
' * Mit \ kann ein Format maskiert werden. damit es nicht geparst wird: m wird als Monat ausgegeben. \m wird zu "m"
' *
' * @example
' */
Public Function format(ByVal iFormat As String) As String
    Dim tmp As String: tmp = StrReverse(iFormat)    'String umdrehen, Da RegExp Lookbehind (?!>..) nicht kennt...
    tmp = formatByRx(tmp, rxFormatParts)
    format = rxMasked.Replace(StrReverse(tmp), "$1")
End Function
 
'/**
' * Fast analog zu Format. Die Patterns müssen aber so definiert werden
' * {$pattern}
' * @example:   "Es geht noch {$d} Tage und {$mx} Monate bis zum Fest"
' */
Public Function format2(ByVal iFormat As String) As String
    Dim tmp As String: tmp = StrReverse(iFormat)    'String umdrehen, Da RegExp Lookbehind (?!>..) nicht kennt...
    tmp = formatByRx(tmp, rxFormatParts2)
    format2 = StrReverse(tmp)
End Function
 
'/**
' * Klont das Objekt
' * @return DateTime
' */
Public Function clone() As DateInterval
    Set clone = DateInterval(Me.intervalSPec)
End Function
 
'/**
' * Erstellt ein Array mit einem Interval. Als erstes Datum wird der aktuelle DateTime verwendet
' * @param  DateInterval/IntervalSpec/Days
' * @param  Long/DateTime/Timestamp         Anzahl Einträge oder ein Endzeitpunkt
' * @param  dtReturnTypes                   Rückgabeformat: timestamp oder DateTime
' * @return Array<timestamp/DateTime>
' */
Public Function interval(ByRef iStart As Variant, ByRef iSizeOrEnd As Variant, Optional ByVal iReturnType As dtReturnTypes = dtTimestamp) As Variant()
    interval = DateTime(iStart).interval(Me, iSizeOrEnd, iReturnType)
End Function
 
 
'/**
' * Ersetzt einen einzelnen Teil des Datums und gibt ein DateTime zurück
' * @param  String      Interval-String gem. DateAdd().  YYYY, M, D, H, N, S, F, Y, WW, W
' * @param  Long     Neuer Wert
' * @param  Boolean     true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateTime
' */
Public Function modify( _
    ByVal iInterval As String, _
    ByVal iNumber As Long, _
    Optional ByVal iByRef As Boolean = False _
) As DateInterval
    With Me.clone
        Select Case UCase(iInterval)
            Case "Y", "YY", "YYYY": .year = iNumber
            Case "M", "MM":         .month = iNumber
            Case "D", "DD":         .day = iNumber
            Case "H", "HH":         .hour = iNumber
            Case "N", "NN":         .minute = iNumber
            Case "S", "SS":         .second = iNumber
            Case "F", "FF":         .nanoSecond = iNumber
        End Select
            Set modify = retDI(.intervalSPec, iByRef)
    End With
End Function
 
'/**
' * Wendet den Interval auf ein DateTime an
' * @param  Date/String/DateTime
' * @param  Boolean                             true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateTime
' */
Public Function addTo(Optional ByRef iTimestamp As Variant = Null, Optional ByVal iByRef As Boolean = False) As DateTime
    Dim dt As DateTime: Set dt = DateTime(iTimestamp)
    Set addTo = dt.add(Me, iByRef)
End Function
 
'/**
' * Gibt ein Wert nach den üblichen Formatierungsbuchstaben zurück
' * @param  String  YMDHNS (auch F)
' * @retrun Integer
' */
Public Function getPartByShort(ByVal iShort As String, Optional ByVal iFormated As Boolean = False) As Variant
    Dim frmt As String
    If Right(UCase(iShort), 1) = "X" Then
        Select Case Right(UCase(iShort), 2)
            Case "MX":              getPartByShort = pMonths:       frmt = String(Len(iShort) - 1, "0")
            Case "DX":              getPartByShort = pDays:         frmt = String(Len(iShort) - 1, "0")
            Case "HX":              getPartByShort = pHours:        frmt = String(Len(iShort) - 1, "0")
            Case "NX":              getPartByShort = pMinutes:      frmt = String(Len(iShort) - 1, "0")
            Case "SX":              getPartByShort = pSeconds:      frmt = String(Len(iShort) - 1, "0")
        End Select
    Else
        Select Case UCase(iShort)
            Case "Y", "YY", "YYYY": getPartByShort = pYear:         frmt = String(Len(iShort), "0")
            Case "M", "MM":         getPartByShort = pMonth:        frmt = String(Len(iShort), "0")
            Case "D", "DD":         getPartByShort = pDay:          frmt = String(Len(iShort), "0")
            Case "H", "HH":         getPartByShort = pHour:         frmt = String(Len(iShort), "0")
            Case "N", "NN":         getPartByShort = pMinute:       frmt = String(Len(iShort), "0")
            Case "S", "SS":         getPartByShort = pSecond:       frmt = String(Len(iShort), "0")
            Case "F", "FF":         getPartByShort = pNanoSecond:   frmt = String(Len(iShort), "0")
        End Select
    End If
    If iFormated Then getPartByShort = Strings.format(getPartByShort, frmt)
End Function
 
'/**
' * Eine Einfache Prüfung, ob ein Interval String dem Format entspricht
' * @param  String      Interval String
' * @return Boolean
' */
Public Function testIntervalString(ByVal iIntervalSpec As String) As Boolean
    testIntervalString = rxIntervalSpec1.test(iIntervalSpec)
    If Not testIntervalString Then testIntervalString = rxIntervalSpec23.test(iIntervalSpec)
End Function
 
'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
'Year
Public Property Get year() As Integer:                  year = pYear:       End Property
Public Property Let year(ByVal iYear As Integer):       pYear = iYear:      End Property
'Month
Public Property Get month() As Integer:                 month = pMonth:     End Property
Public Property Let month(ByVal iMonth As Integer):     pMonth = iMonth:    End Property
'Day
Public Property Get day() As Integer:                   day = pDay:         End Property
Public Property Let day(ByVal iDay As Integer):         pDay = iDay:        End Property
'Hour
Public Property Get hour() As Integer:                  hour = pHour:       End Property
Public Property Let hour(ByVal iHour As Integer):       pHour = iHour:      End Property
'Minute
Public Property Get minute() As Integer:                minute = pMinute:   End Property
Public Property Let minute(ByVal iMinute As Integer):   pMinute = iMinute:  End Property
'Second
Public Property Get second() As Integer:                second = pSecond:   End Property
Public Property Let second(ByVal iSecond As Integer):   pSecond = iSecond:  End Property
 
Public Property Get nanoSecond() As Long:               nanoSecond = pNanoSecond:                       End Property
Public Property Let nanoSecond(ByVal iNS As Long):      pNanoSecond = iNS:                              End Property
 
Public Property Get microSecond() As Long:              microSecond = CLng(pNanoSecond / 10 ^ 3):       End Property
Public Property Let microSecond(ByVal iMS As Long):     pNanoSecond = iMS * 10 ^ 3:                     End Property
 
Public Property Get milliSecond() As Long:              milliSecond = CLng(pNanoSecond / 10 ^ 6):       End Property
Public Property Let milliSecond(ByVal iMS As Long):     pNanoSecond = iMS * 10 ^ 6:                     End Property
 
'Sign
Public Property Get sign() As Integer:                  sign = pSign:       End Property
Public Property Let sign(ByVal iSign As Integer):       pSign = iSign:      End Property
 
'Die folgenden Properties werden nur bei Diff abgeüllt. Ansonsten sind sie EMPTY
'Sie Representatieren die Totaldifferez in der jeweiligen Einheit inkl. Vorzeichen
'Im Grunde also das Resultat von VBA.DateDiff() auf die jeweilige Einheit
'Years
Public Property Get years() As Variant:                 years = pYears * pSign:     End Property
Public Property Let years(ByVal iYears As Variant):     pYears = iYears:            End Property
'Months
Public Property Get months() As Variant:                months = pMonths * pSign:   End Property
Public Property Let months(ByVal iMonths As Variant):   pMonths = iMonths:          End Property
'Days
Public Property Get days() As Variant:                  days = pDays * pSign:       End Property
Public Property Let days(ByVal iDays As Variant):       pDays = iDays:              End Property
'Hours
Public Property Get hours() As Variant:                 hours = pHours * pSign:     End Property
Public Property Let hours(ByVal iHours As Variant):     pHours = iHours:            End Property
'Minutes
Public Property Get minutes() As Variant:               minutes = pMinutes * pSign: End Property
Public Property Let minutes(ByVal iMinutes As Variant): pMinutes = iMinutes:        End Property
'Seconds
Public Property Get seconds() As Variant:               seconds = pSeconds * pSign: End Property
Public Property Let seconds(ByVal iSeconds As Variant): pSeconds = iSeconds:        End Property
 
'/**
' * Gibt den Interval als IntervalSpec zurück: P[n]Y[n]M[n]DT[n]H[n]M[n]S
' * http://en.wikipedia.org/wiki/ISO_8601#Durations
' * Das Vorzeichen wird ignoriert
' * @return String
' */
Public Property Get intervalSPec() As String
    intervalSPec = "P"
    If pYear > 0 Then intervalSPec = intervalSPec & pYear & "Y"
    If pMonth > 0 Then intervalSPec = intervalSPec & pMonth & "M"
    If pDay > 0 Then intervalSPec = intervalSPec & pDay & "D"
 
    If pHour + pMinute + pSecond > 0 Then intervalSPec = intervalSPec & "T"
    If pHour > 0 Then intervalSPec = intervalSPec & pHour & "H"
    If pMinute > 0 Then intervalSPec = intervalSPec & pMinute & "M"
    If pSecond > 0 Then intervalSPec = intervalSPec & pSecond & "S"
    If pNanoSecond > 0 Then intervalSPec = intervalSPec & Mid(pNanoSecond / 10 ^ 9, 3) & "F"
 
'    If Not iAbsolute And pSign = -1 Then intervalSPec = "-" & intervalSPec
End Property
Public Property Let intervalSPec(ByVal iIntervalSpec As String)
    retDI iIntervalSpec, True
End Property
 
' /**
' * IntervalSpecin der Schreibweise: P[YYYY][MM][DD]T[hh][mm][ss]
' * Das Vorzeichen wird ignoriert
' * @return String
' */
Public Property Get intervalSPec2() As String
    intervalSPec2 = format("PYYYYMMDDTHHNNSS")
End Property
Public Property Let intervalSPec2(ByVal iIntervalSpec As String)
    retDI iIntervalSpec, True
End Property
 
' /**
' * IntervalSpecin der Schreibweise: und P[yyyy]-[mm]-[dd]T[hh]:[mm]:[ss]
' * Das Vorzeichen wird ignoriert
' * @return String
' */
Public Property Get intervalSPec3() As String
    intervalSPec3 = format("PYYYY-MM-DDTHH:NN:SS")
    If pNanoSecond <> 0 Then intervalSPec3 = intervalSPec3 & "." & Mid(pNanoSecond / 10 ^ 9, 3)
End Property
Public Property Let intervalSPec3(ByVal iIntervalSpec As String)
    retDI iIntervalSpec, True
End Property
 
'/**
' * Gibt ein String-Wert eines Objektes zurück
' * @return String
' */
Public Property Get toString() As String
    toString = intervalSPec
End Property
 
#If IFormattable_exists Then
    '/**
    ' * Gibt das Objekt als IFormattable zurück
    ' * @return IFormattable
    ' */
    Public Property Get IFormattableObject() As IFormattable
        Set IFormattableObject = Me
    End Property
 
    '-------------------------------------------------------------------------------
    ' -- Interface methodes/properties
    '-------------------------------------------------------------------------------
    '/**
    ' * Gibt ein String-Wert eines Objektes zurück
    ' * @return String
    ' */
    Private Property Get IFormattable_object() As Object
        Set IFormattable_object = Me
    End Property
 
 
    '/**
    ' * Gibt das Originalobjekt  zurück
    ' * @object
    ' */
    Private Property Get IFormattable_toString() As String
        IFormattable_toString = toString
    End Property
#End If
 
'-------------------------------------------------------------------------------
' -- Private Methodes
'-------------------------------------------------------------------------------
'/**
' * Wandelt Pattern in Werte um. Je nach RegExp
' * @param  String
' * @param  RegExp
' * @return String
' */
Private Function formatByRx(ByRef iFormatReverse As String, ByRef iRx As Object) As String
    formatByRx = iFormatReverse
    Do While iRx.test(formatByRx)
        Dim m As Object: Set m = iRx.execute(formatByRx)(0)
        If m.subMatches(0) = "r" Then
            formatByRx = repl(formatByRx, m, pSign, ";-;")
        ElseIf m.subMatches(0) = "R" Then
            formatByRx = repl(formatByRx, m, pSign, "+;-;")
        Else
            formatByRx = repl(formatByRx, m, getPartByShort(StrReverse(m.subMatches(0)), True))
        End If
    Loop
End Function
 
'/**
' * Setzt alle Werte zurück
' */
Private Sub clear()
    pYear = 0
    pMonth = 0
    pDay = 0
    pHour = 0
    pMinute = 0
    pSecond = 0
    pNanoSecond = 0
    pWeekDays = 0
    pWeeks = 0
    pYears = 0
    pMonths = 0
    pDays = 0
    pHours = 0
    pMinutes = 0
    pSeconds = 0
    pSign = 1
End Sub
 
'/**
' * Handelt den Return. Ob das aktuelle Objekt angepasst wird oder nicht
' * @param  IntervalSpec
' * @param  Boolean     true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateInterval
' */
Private Function retDI(ByVal iInterval As Variant, ByVal iByRef As Boolean) As DateInterval
    If TypeName(iInterval) = "DateInterval" Then
        Set retDI = IIf(iByRef, iInterval, iInterval.clone)
    ElseIf Not IsObject(iInterval) Then
        Set retDI = DateInterval(iInterval)
    End If
End Function
 
'/**
' * Hilfsfunktion für format()
' */
Private Function repl(ByVal iTmp As String, ByRef iM As Object, ByVal iNumber As Variant, Optional ByVal iFormat As String = Empty) As String
    repl = Left(iTmp, iM.firstIndex) & StrReverse(iNumber) & Mid(iTmp, iM.firstIndex + iM.length + 1)
End Function
 
'/**
' * Berechnet eine Teildifferent und reduziert ioFromD um diese Grösse
' * @param  Date
' * @param  Date
' * @param  Interval
' * @return Integer
' */
Private Function diffPart(ByRef ioFromD As Date, ByVal iToD As Date, ByVal iInterval As String) As Integer
    diffPart = DateDiff(iInterval, ioFromD, iToD)
    If round(DateAdd(iInterval, diffPart, ioFromD), 10) > round(iToD, 10) Then diffPart = diffPart - 1
    ioFromD = DateAdd(iInterval, diffPart, ioFromD)
End Function
 
'/**
' * Versucht aus einer Eingabe ein Datum zu erstellen
' * @param  Date/DateTime/String
' * @return Date
' */
Private Function getDate(ByRef iDate As Variant, Optional ByRef ioNanoSecond As Long = 0) As Date
    Select Case TypeName(iDate)
        Case "DateTime":    getDate = iDate.timestamp:                      ioNanoSecond = iDate.nanoSecond
        Case "Date":        getDate = iDate:                                ioNanoSecond = 0
        Case "String":      getDate = dateValue(iDate) + timeValue(iDate):  ioNanoSecond = 0
        Case "Null":        getDate = Now:                                  ioNanoSecond = 0   '//TODO
        Case Else:          Err.Raise 13, "DateInterval.getDate"          '13  Type mismatch
    End Select
End Function
 
'-------------------------------------------------------------------------------
' -- Private Properties
'-------------------------------------------------------------------------------
 
'/**
' * RegExp um ein intervalSpec zu zerlegen
' * P[n]Y[n]M[n]W[n]DT[n]H[n]M[n]F[n]S
' */
Private Property Get rxIntervalSpec1() As Object
    Static pRx As Object
    If pRx Is Nothing Then Set pRx = cRx("/^(-?)(?:P(?:(\d+)Y)?(?:(\d+)M)?(?:(\d+)W)?(?:(\d+)D)?)?(?:T(?:(\d+)H)?(?:(\d+)M)?(?:(\d+)S)?(?:(\d+)F)?)?$/i")
    Set rxIntervalSpec1 = pRx
End Property
 
 
'/**
' * RegExp um ein intervalSpec2 oder 3 zu zerlegen
' * IntervalSpec2: P[yyyy][mm][dd]T[hh][mm][ss]
' * IntervalSpec3: P[yyyy]-[mm]-[dd]T[hh]:[mm]:[ss].[fff]
' */
Private Property Get rxIntervalSpec23() As Object
    Static pRx As Object
    If pRx Is Nothing Then Set pRx = cRx("/^(-?)P(\d{4})(-?)(\d{2})\3(\d{2})T(\d{2})(:?)(\d{2})\7(\d{2})(\.?)(\d{1,3})$/i")
    Set rxIntervalSpec23 = pRx
End Property
 
'/**
' * regExp um die Part-Strings zu erkennen
' */
Private Property Get rxFormatParts() As Object
    Static pRx As Object
    If pRx Is Nothing Then Set pRx = cRx("/(r|yyyy|yy|y|xm+|mm|m|xd+|dd|d|xh+|xh|hh|h|xn+|xn|nn|n|xs+|xs|ss|s|f{1,9})(?!\\)/ig")
    Set rxFormatParts = pRx
End Property
 
'/**
' * regExp um die Part-Strings zu erkennen
' */
Private Property Get rxFormatParts2() As Object
    Static pRx As Object
    If pRx Is Nothing Then Set pRx = cRx("/\}" & rxFormatParts.pattern & "\$\{/ig")
    Set rxFormatParts2 = pRx
End Property
 
'/**
' * Erkennt Maskierte Patterns
' */
Private Property Get rxMasked() As Object
    Static pRx As Object
    If pRx Is Nothing Then Set pRx = cRx("/\\([rymdhns])/gi")
    Set rxMasked = pRx
End Property
'-------------------------------------------------------------------------------
' -- Private Events
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
    pSign = 1
End Sub
 
'-------------------------------------------------------------------------------
' -- Private Libraries
'-------------------------------------------------------------------------------
 
'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function
 
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Gibt den Grössten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example greatest("Hallo Welt", 42, "Mister-X") -> Mister-X
'*/
Private Function greatest(ParamArray itemS() As Variant) As Variant
    Dim item As Variant
    For Each item In itemS
        If item > greatest Then greatest = item
    Next item
End Function
 
'/**
' * Gibt den Kleinsten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example least("Hallo Welt", 42, "Mister-X") -> 42
'*/
Private Function least(ParamArray itemS() As Variant) As Variant
    least = itemS(LBound(itemS))
    Dim item As Variant: For Each item In itemS
        If NZ(item) < NZ(least) Then least = item
    Next item
End Function
 
'/**
' * Gibt den String iString zurück. Dieser wurde nach links mit dem String iPadString auf eine Länge von iLen Zeichen aufgefüllt.
' * Wenn iString länger als iLen ist, wird der Rückgabewert auf iLen Zeichen gekürzt.
' * @param  String
' * @param  Integer     Neue Länge
' * @param  String      Zeichen mit dem verlängert wird
' * @return Erweiterter oder gekürzter String
' */
Private Function lPad( _
        ByVal iString As String, _
        ByVal iLen As Integer, _
        Optional ByVal iPadString As String = " " _
) As String
    lPad = Left(iString, iLen)
    lPad = lPad & String(iLen - Len(lPad), iPadString)
End Function
 
#If Not isAccess Then
    '/**
    ' * Wandelt NULL in EMpty oder einen Defaultwert
    ' * @param  Variant
    ' * @param  Variant
    ' * @return Variant
    ' */
    Private Function NZ(ByRef iValue As Variant, Optional ByRef iDefault As Variant = Empty) As Variant
        If IsNull(iValue) Then
            NZ = iDefault
        Else
            NZ = iValue
        End If
    End Function
#End If