Public Function GetDateFromWeek(ByVal nWeek As Integer, _
Optional ByVal nDayOfWeek As VBA.VbDayOfWeek = vbMonday, _
Optional ByVal nYear As Integer = -1) As Date
Dim nCurWeek As Integer
Dim vStart As Variant
Dim vMonday As Variant
Dim vSunday As Variant
Dim nDay As Integer
If nYear = -1 Then nYear = Year(Now)
vStart = DateSerial(nYear, Month(Now), Day(Now))
nCurWeek = Val(Format$(vStart, "ww", vbMonday))
vStart = DateAdd("ww", nWeek - nCurWeek, vStart)
nDay = Weekday(vStart, vbMonday)
If nDayOfWeek = vbSunday Then
GetDateFromWeek = DateAdd("d", -nDay + 7, vStart)
Else
GetDateFromWeek = DateAdd("d", -nDay + nDayOfWeek - 1, vStart)
End If
End Function
Public Function DIN_KW(DasDatum As Date) As Byte
Dim KW As Date
KW = 4 + DasDatum - Weekday(DasDatum, 2)
DIN_KW = (KW - DateSerial(Year(KW), 1, -6)) \ 7
End Function
Private Sub SpinButton1_Change()
On Error GoTo ErrHand
With SpinButton1
.Min = 1
.Max = 52
End With
Dim Scanartikel
Set Scanartikel = Sheets("Warenbewegung").Columns(1).Find(what:=Right(Artikel, 4))
Dim rng3 As Range
Set rng3 = Sheets("Warenbewegung").Columns(5)
Dim rng As Range
Set rng = Sheets("Warenbewegung").Columns(1)
Dim rng2 As Range
Set rng2 = Sheets("Warenbewegung").Columns(4)
Dim VerbrauchOhneHeute, VerbrauchmitHeute
Dim vMonday As Date
Dim vSunday As Date
vMonday = GetDateFromWeek(SpinButton1.Value + 1, vbMonday, Year(Now))
vSunday = GetDateFromWeek(SpinButton1.Value + 1, vbSunday, Year(Now))
If Not Scanartikel Is Nothing Then
VerbrauchOhneHeute = Application.WorksheetFunction.SumIfs(rng3, rng, Scanartikel, rng3, "<1", rng2, ">=" & CLng(vMonday), rng2, "<=" & CLng(vSunday))
VerbrauchmitHeute = Application.WorksheetFunction.SumIfs(rng3, rng, Scanartikel, rng3, "<1", rng2, "=" & Date)
Paletten.Value = (VerbrauchOhneHeute + VerbrauchmitHeute) / -1
Verbrauchsgrenze.text = vMonday & " - " & vSunday
Label16 = "Verbrauch in KW " & DIN_KW(vMonday)
Else
MsgBox "Artikel wurde noch nicht verbraucht!"
End If
Exit Sub
ErrHand:
MsgBox "Bitte tragen Sie ein Start- und Enddatum ein!"
Exit Sub
End Sub
Private Function Calendar_Week(ByVal pvdtmDate As Date) As Integer
Dim dtmTempDate As Date
dtmTempDate = DateSerial(Year(pvdtmDate + (8 - Weekday(pvdtmDate)) Mod 7 - 3), 1, 1)
Calendar_Week = (pvdtmDate - dtmTempDate - 3 + (Weekday(dtmTempDate) + 1) Mod 7) \ 7 + 1
End Function
Private Sub UserForm_Initialize()
On Error GoTo Fehler
SpinButton1.Value = Calendar_Week(Date)
With Verbrauchsübersicht.Artikel
Dim rng As Range
For Each rng In Sheets("Artikelübersicht").Range("A1:A1000")
If rng > "0" Or rng <> "" Then .AddItem rng
Next
End With
Exit Sub
Fehler:
MsgBox Err.Description
End Sub