Private Color1&(), BlueDay() As Boolean
 
Private Sub Form_Load()
 
  Call Kalender
 
End Sub
 
Private Sub Kalender()
 
  Dim Tage&, Jahr&, i&, j&, WT&
  Dim Dtm1 As Date, Dtm2 As Date
 
  Jahr = Year(Now)
  With MSFlexGrid1
    .Redraw = False
    .Clear
    .Rows = 13
    .Cols = 38
    .FixedRows = 1
    .FixedCols = 1
    ReDim Color1(.FixedRows To .Rows - 1, .FixedCols To .Cols - 1)
    ReDim BlueDay(.FixedRows To .Rows - 1, .FixedCols To .Cols - 1)
    .Font.Size = 14
    .Font.Bold = True
    .ColAlignment(-1) = flexAlignCenterCenter
    .ColWidth(-1) = 40 * Screen.TwipsPerPixelX
    .RowHeight(-1) = 30 * Screen.TwipsPerPixelX
    .ColWidth(0) = 120 * Screen.TwipsPerPixelX
    .ColAlignment(0) = flexAlignLeftCenter
    .Row = 0
    .Col = 0
    .CellAlignment = flexAlignCenterCenter
    .TextMatrix(0, 0) = "> " & Jahr & " <"
    .ScrollTrack = True
    .ScrollBars = flexScrollBarBoth
    For i = .FixedCols To .Cols - 1
      .TextMatrix(0, i) = WeekdayName(1 + ((i - 1) Mod 7), True, vbMonday)
    Next i
    For i = 1 To 12
      Dtm1 = "01." & Format$(i, "00") & "." & Jahr
      If i = 12 Then
        Tage = 31
      Else
        Dtm2 = "01." & Format$(i + 1, "00") & "." & Jahr
        Tage = DateDiff("d", Dtm1, Dtm2)
      End If
      WT = Weekday(Dtm1, vbMonday)
      .TextMatrix(i, 0) = MonthName(i, False)
      For j = 1 To Tage
        .TextMatrix(i, j + WT - 1) = j
      Next j
    Next i
    .FillStyle = flexFillRepeat
    For i = .FixedRows To .Rows - 1 Step 2
      .Row = i
      .Col = .FixedCols
      .RowSel = i
      .ColSel = .Cols - 1
      .CellBackColor = RGB(255, 255, 222)
    Next i
    For i = 7 To .Cols - 1 Step 7
      .Row = .FixedRows
      .Col = i
      .RowSel = .Rows - 1
      .ColSel = i
      .CellBackColor = RGB(255, 160, 160)
      .CellForeColor = vbWhite
    Next i
    .FillStyle = flexFillSingle
    For i = .FixedRows To .Rows - 1
      .Row = i
      For j = .FixedCols To .Cols - 1
        .Col = j
        Color1(i, j) = .CellBackColor
      Next j
    Next i
    .Row = .FixedRows
    .Col = .FixedCols
    .ZOrder vbBringToFront
    .Redraw = True
  End With
 
End Sub
 
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As _
  Single, y As Single)
 
  Dim i&, j&, C1&, C2&, S1&, S2&
 
  If Button = vbLeftButton Then
    With MSFlexGrid1
      .Redraw = False
      C1 = .Col
      C2 = .ColSel
      S1 = IIf(.RowSel < .Row, -1, 1)
      S2 = IIf(.ColSel < .Col, -1, 1)
      For i = .Row To .RowSel Step S1
        .Row = i
        For j = C1 To C2 Step S2
          If Trim$(.TextMatrix(i, j)) <> "" Then
            .Col = j
            If BlueDay(i, j) = True Then
              .CellBackColor = Color1(i, j)
            Else
              .CellBackColor = RGB(128, 128, 255)
            End If
            BlueDay(i, j) = Not BlueDay(i, j)
          End If
        Next j
      Next i
      .Redraw = True
    End With
  End If
 
End Sub

Gruss,

Zardoz