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

如何解决访问VBA：将ISO周编号转换为日期范围时出错

我正在尝试根据ISO周编号创建一个简单的周选择器，每当用户单击“当前周”或“上周”或“下周”时，它将为我提供星期一和星期日的日期按钮，因为我将选择那些日期内的所有交易。

我已经按照以下步骤操作了 MS Access get ISO standard week number 以获得特定日期的正确星期数，然后将星期数转换回https://answers.microsoft.com/en-us/msoffice/forum/msoffice_access-mso_other/convert-week-number-to-date/3d0f8c90-a155-e011-8dfc-68b599b31bf5之后的日期。

今年的转换效果很好，每当我单击上一个或下一个星期时，它都会带来正确的星期一和星期日以及正确的星期数，但是，当它到达2021年的第一周时，就会带来正确的日期为04/01/2021和10/01/2021（分别为从和到），则单击“下周”将带上日期为“从= 06/01/2021”和“至= 12/01/2021” ，并且停止前进，点击不会更改日期。

单击“上一个星期”时，它会一直持续到2020年的第1周，这将带来正确的日期30/12/2019和05/01/2020，但是，单击下一个“上一个星期”将带来日期23 2018年12月12日和2018年12月29日，但是在这种情况下，如果我继续单击“上周”按钮，它将继续正确返回到2018年。真是发疯了。

我认为将周数转换为日期范围时出现问题是在DateSerial中，我试图弄清楚，但我做不到。

我希望你们能帮助我。

谢谢。

'''' 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,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",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,1) + 4)

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

End Sub

解决方法

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

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

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,CPH.
'
Public Function DateNextWeekUltimo( _
    ByVal DateThisWeek As Date,DateThisWeek)

    ' Return last weekday with no time part.
    ResultDate = DateAdd("d",7 - Weekday(ResultDate,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,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,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,CPH.
'
Public Function DatePreviousWeekUltimo( _
    ByVal DateThisWeek As Date,Fix(ResultDate))
    
    DatePreviousWeekUltimo = ResultDate
    
End Function