Public Function CalendarWeek(ByVal nWeek As Integer, ByVal nYear As Integer) As _
  Date
 
' Wochentag des 4. Januar des Jahres ermitteln
Dim dStart As New Date(nYear, 1, 4)
Dim nDay As Integer = (dStart.DayOfWeek + 6) Mod 7 + 1
 
' Beginn der 1. KW des Jahres
Dim dFirst As Date = dStart.AddDays(1 - nDay)
 
' Gesuchte KW ermitteln
Return dFirst.AddDays((nWeek - 1) * 7)
End Function

Public Function DateToWeek(ByVal dDate As Date) As String
' Startdatum der ersten Kalenderwoche des Jahres und Folgejahres berechnen
Dim dThisYear As Date = CalendarWeek(1, dDate.Year)
Dim dNextYear As Date = CalendarWeek(1, dDate.Year + 1)
 
' Prüfen, ob Datum zur ersten Woche des Folgejahres gehört
If dDate >= dNextYear Then
' Rückgabe: KW 1 des Folgejahres
Return dDate.Year + 1 & "01"
Else
' KW = Differenz zum ersten Tag der ersten Woche
Return dDate.Year & Format$(dDate.Subtract(dThisYear).Days \ 7 + 1, "00")
End If
End Function

 Dim day As Integer = 1
Dim month As Integer = 1
Dim year As Integer = Today.Year
Dim strKW As String = ""
Dim c As Integer = 0
Dim KW As Integer = 0
Dim KW_old As Integer = 0
Dim first_weekday As Integer = 0
Dim first_weekday_month As Integer = 0
Dim firstrun As Boolean = False
 
Do Until month > 12
Do Until day > Date.DaysInMonth(year, month)
strKW = DateToWeek(CDate(day & "." & month & "." & year))
KW = strKW.Substring(4, 2)
If KW <> KW_old Then
RichTextBox1.Text &= "KW " & KW & " / " & first_weekday & "." & _
  first_weekday_month & ". - " & day - 1 & "." & month & "." & year & vbCrLf
firstrun = True
Else
If firstrun Then
first_weekday = day - 1
first_weekday_month = month
End If
firstrun = False
End If
day = day + 1
KW_old = KW
Loop
day = 1
month = month + 1
Loop