Private Function Week(dteValue As Date) As Integer

'Monday is set as first day of week

   Dim lngDate As Long

Dim intWeek As Integer

'If january 1. is later then thursday, january 1. is not in week 1

   If Not Weekday("01/01/" & Year(dteValue), vbMonday) > 4 Then

      intWeek = 1

Else

      intWeek = 0

End If

'Sets long-value for january 1.

   lngDate = CLng(CDate("01/01/" & Year(dteValue)))

'Finds the first monday of year

   lngDate = lngDate + (8 - Weekday("01/01/" & Year(dteValue), vbMonday))

'Increases week by week until set date is passed

   While Not lngDate > CLng(CDate(dteValue))

      intWeek = intWeek + 1

      lngDate = lngDate + 7

Wend

'If the date set is not in week 1, this finds latest week previous year

   If intWeek = 0 Then

      intWeek = Week("31/12/" & Year(dteValue) - 1)

End If

   Week = intWeek

End Function

msgbox "Сейчас идёт " &

CStr(Week(Now)) & " неделя."