抛砖引玉：求当前日期周数的程序？谁能帮我看看？

QINGSOLI

[glow=255,red,2]我不太会写程序，希望能有一个简洁明了的返回当前日期周数的程序。[/glow]

Function Weeks(dateDay As Date, Optional WeekOfStart = vbMonday, Optional ReturnFormat = "WW") As String
On Error GoTo Err_Weeks

Dim dateThisYear As Date
Dim intStart As Integer
Dim intDays As Integer
Dim dateYear As String

   
    'If the end month of year
    If Month(dateDay) = 12 Then
        If dateDay > CDate(CStr(Year(dateDay) + 1) & "-1-1") - Weekday(CDate(CStr(Year(dateDay) + 1) & "-1-1"), WeekOfStart) Then
            dateYear = CStr(Year(dateDay) + 1)
            Else
            dateYear = Year(dateDay)
        End If
        Else
        dateYear = Year(dateDay)
    End If
    dateThisYear = CDate(CStr(dateYear) & "-1-1")
    intStart = Weekday(dateThisYear, WeekOfStart)
    intDays = dateDay - dateThisYear
    If ReturnFormat = "YYYYWW" Then
        Weeks = dateYear & Format(Int((intDays + intStart - 1) / 7) + 1, "00")
        Else
        Weeks = Format(Int((intDays + intStart - 1) / 7) + 1, "00")
    End If
   
Exit_Weeks:
    Exit Function
   
Err_Weeks:
    Weeks = “ERROR"
    Resume Exit_Weeks

End Function


函数调用说明：
Weeks(日期 [,一个星期的第一天] [,返回格式])
dateDay-->要返回的日期
WeekOfStart-->一个星期的第一天，可以为1-7的任一值，默认为星期一
       分别为：vbSunday (1), vbMonday (2), vbTuesday (3), vbWednesday (4)
                   vbThursday (5) , vbFriday (6), vbSaturday (7)
ReturnFormat-->返回格式，两个选择，"WW"，周数，"YYYYWW"，年+周数

如： Weeks(#2003-5-12#,2,"YYYYWW")
       200320

       Weeks(#2003-5-11#,2,"YYYYWW")
       200319

       Weeks(#2003-5-11#,1,"YYYYWW")
       200320

[此贴子已经被作者于2003-5-14 13:35:42编辑过]

QINGSOLI

我的程序太长了，希望能有高手写一段简洁的程序：）多谢！