User Tools

Site Tools


vba:functions:week2date

Table of Contents

[VBA] week2date()

Gibt Das Dazum eines bestimmten Wochentages in einer bestimmten Woche des Jahres aus

Version 1.0.0 - 29.02.2016

Beispiele

'Erste Wochentag in der 9ten Woche des aktuellen Jahres
?week2date(9)
29.02.2016 
 
'Freitag derselben Woche
?week2date(9, vbFriday)
04.03.2016 
 
'Wieder den Freitag. Dieses mal mit der Definition, dass die Wochen mit der 1ten Januar-Tag beginnt
'Und das ganze im Jahr 2017
?week2date(9, vbFriday,,,vbFirstJan1)
26.02.2016 
 
'Und ein Datum in einem bestimmten Jahr
?week2date(9,,2017)
06.03.2017

Code

Falls man das Modul nicht importiert sondern mit Copy-Paste in ein neues Modul kopiert, muss die Zeile Attribute VB_Name = “DDLFile” weggelassen werden.

udf_week2date.bas
Attribute VB_Name = "udf_week2date"
'-------------------------------------------------------------------------------
'File         : udf_week2date.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/week2date
'Environment  : VBA 2007 +
'Version      : 1.0.0
'Name         : week2date
'Author       : Stefan Erb (ERS)
'History      : 29.02.2016 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
 
Private Enum sysLocale
    LOCALE_IFIRSTDAYOFWEEK = &H100C   'first day of week specifier 0=Mon, 6=Sun                 https://msdn.microsoft.com/en-us/library/windows/desktop/dd373771%28v=vs.85%29.aspx
    LOCALE_IFIRSTWEEKOFYEAR = &H100D  'first week of year specifier 0=direct, 1=Full, 2=4days   https://msdn.microsoft.com/en-us/library/windows/desktop/dd373772%28v=vs.85%29.aspx
End Enum
 
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Declare Function getLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
 
 
'/**
' * Gibt das Datum eines bestimmten Wochentages in einer bestimmten Jahreswoche zurck
' * @param  Integer             Wochennummer
' * @param  VbDayOfWeek         Tag der Woche. vbSunday = 1, vbMonday = 2 etc.
' * @param  Variant<Long>       Das Jahr
' * @param  vbDayOfWeek         Erster Tag der Woche
' * @param  vbFirstWeekOfYear   Definition der ersten Kalenderwoche im Kalender
' */
Public Function week2date( _
        ByVal iWeek As Integer, _
        Optional ByVal iWeekDay As VbDayOfWeek = vbUseSystemDayOfWeek, _
        Optional ByVal iYear As Variant = Null, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As Date
    'Gennschter Wochentag bestimmen
    Dim weekDay As VbDayOfWeek: weekDay = IIf(iWeekDay = vbUseSystemDayOfWeek, systemFirstDayOfWeek, iWeekDay)
    'Erster Januar
    Dim date1Jan As Date:       date1Jan = DateSerial(NZ(iYear, year(Now())), 1, 1)
    'Korrektur, falls die Wochennummer aufs Vorjahr fllt + Anzahl Wochen (Wochenzahl -1)
    Dim deltaWeeks As Integer:  deltaWeeks = Abs(DatePart("ww", date1Jan, iFirstDayOfWeek, iFirstWeekOfYear) <> 1) + (iWeek - 1)
    'Delta der Wochentagverschiebung berechnen
    Dim deltaDays As Integer:   deltaDays = getDayIdx(weekDay, iFirstDayOfWeek) - getDayIdx(DatePart("w", date1Jan), iFirstDayOfWeek)
    'Die Deltas zum 1. Januar dazu rechnen
    week2date = DateAdd("d", deltaDays + 7 * deltaWeeks, date1Jan)
End Function
 
'/**
' * FirstDayOfWeek ausden User/Systemsettings des PC
' * @return vbDayOfWeek     Erster Tag der Woche
' */
Private Static Property Get systemFirstDayOfWeek() As VbDayOfWeek
    Static firstDayOfWeek As VbDayOfWeek
    If firstDayOfWeek = 0 Then
        Dim LCID As Long: LCID = GetUserDefaultLCID()
        If LCID = 0 Then LCID = GetSystemDefaultLCID()
        If LCID <> 0 Then
            Dim sReturn As String * 2
            '0=Mon, 6=Sun
            getLocaleInfo LCID, LOCALE_IFIRSTDAYOFWEEK, sReturn, Len(sReturn)
            firstDayOfWeek = CInt(Trim(sReturn)) + 2
        End If
        If firstDayOfWeek > 7 Then firstDayOfWeek = firstDayOfWeek - 7
    End If
    systemFirstDayOfWeek = firstDayOfWeek
End Property
 
'/**
' * Ermittelt den Index eines Wochentages anhand des FirstDayOfWeek.
' * @param  vbDayOfWeek         Tag der Woche
' * @param  vbDayOfWeek         Erster Tag der Woche
' * @return Integer     Index, 0-6
' *
Private Function getDayIdx(ByVal iWeekDay As VbDayOfWeek, Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbMonday) As Integer
    getDayIdx = iWeekDay - iFirstDayOfWeek
    If getDayIdx < 0 Then getDayIdx = 7 + getDayIdx
End Function
 
 
vba/functions/week2date.txt · Last modified: 25.08.2016 09:02:28 by yaslaw