访问VBA：将ISO周号转换为日期范围时出错

Question

我试图创建一个基于ISO周号的简单周选择器，它将给我周一日期和周日日期每次用户点击“当前周”或“前一周”或“下周”按钮，因为我将选择这些日期内的所有交易。

希望你们能帮帮我。

提前谢谢你。

'''' This is the function in a module to get the week number

Public Function ISOWeek(MyDate As Date) As Integer

    ISOWeek = Format(MyDate, "ww", vbMonday, vbFirstFourDays)
    
    If ISOWeek > 52 Then
    
        If Format(MyDate + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then ISOWeek = 1
        
    End If

End Function


'''' These subs run on the form code

Private Sub NextWeek_Click()

    Dim SelectedWeek As Date

    SelectedWeek = Me.Date_From.Value

    FirstDayWeek = DateAdd("ww", ISOWeek(SelectedWeek), DateSerial(Year(SelectedWeek), 1, 1) - 2)

    LastDayWeek = DateAdd("ww", ISOWeek(SelectedWeek), DateSerial(Year(SelectedWeek), 1, 1) + 4)

    Me.Date_From.Value = FirstDayWeek
    Me.Date_To.Value = LastDayWeek

End Sub

Private Sub PreviousWeek_Click()

    Dim SelectedWeek As Date

    SelectedWeek = Me.Date_From.Value
    
    FirstDayWeek = DateAdd("ww", ISOWeek(SelectedWeek) - 2, DateSerial(Year(SelectedWeek), 1, 1) - 2)

    LastDayWeek = DateAdd("ww", ISOWeek(SelectedWeek) - 2, DateSerial(Year(SelectedWeek), 1, 1) + 4)

    Me.Date_From.Value = FirstDayWeek
    Me.Date_To.Value = LastDayWeek

End Sub

Answer 1

从日期计算中保留周数，它们只会使事情复杂化。

通过使用下面列出的泛型函数，您的两个函数可以简化为：

Private Sub NextWeek_Click()

    Me.Date_From.Value = DateNextWeekPrimo(Me.Date_From.Value, vbMonday)
    Me.Date_To.Value = DateNextWeekUltimo(Me.Date_From.Value, vbMonday)

End Sub

Private Sub PreviousWeek_Click()

    Me.Date_From.Value = DatePreviousWeekPrimo(Me.Date_From.Value, vbMonday)
    Me.Date_To.Value = DatePreviousWeekUltimo(Me.Date_From.Value, vbMonday)

End Sub


' Returns the primo date of the week following the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateNextWeekPrimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = 1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)
    
    ' Return first weekday with no time part.
    ResultDate = DateAdd("d", 1 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DateNextWeekPrimo = ResultDate
    
End Function


' Returns the ultimo date of the week following the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateNextWeekUltimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = 1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)

    ' Return last weekday with no time part.
    ResultDate = DateAdd("d", 7 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DateNextWeekUltimo = ResultDate
    
End Function


' Returns the primo date of the week preceding the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatePreviousWeekPrimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = -1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)
    
    ' Return first weekday with no time part.
    ResultDate = DateAdd("d", 1 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DatePreviousWeekPrimo = ResultDate
    
End Function


' Returns the ultimo date of the week preceding the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatePreviousWeekUltimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = -1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)

    ' Return last weekday with no time part.
    ResultDate = DateAdd("d", 7 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DatePreviousWeekUltimo = ResultDate
    
End Function