Schichtkalender - 29.Februar
29.01.2008 16:52:00
Marc
wieder mal eine Frage zu einem Schichtkalender. Es handelt sich um den 29.Februar.
Ich schaffe es wunderbar einen Kalender zu generieren, der ein Schaltjahr hat. Wähle ich aber ein anderes Jahr (im Feld A66) aus, so stoppt das Makro am 29.Februar, da hier ein ""-Wert eingetragen ist. und es nicht über weekdays(...) einen Wert bestimmen kann. Der Absatz ist fett markiert unten.
Wäre super, wenn mir jemand helfen kann. Danke.
Gruß
Marc
Private Sub CommandButton41_Click()
Application.ScreenUpdating = False
[Auswahllisten!A66].Value = TextBox41.Value
ActiveSheet.Name = [M2]
If Len(TextBox41.Text)
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Versuch'funktioniert
'If Target.Column = 1 Then 'If Target.Row=1(ZEILE)'If Target.Column(SPALTE)überspringen
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Range("D6:H36, K6:O36, R6:V36, Y6:AC36, AF6:AJ36, AM6:AQ36, D45:H75, K45:O75, R45: _
_
V75, Y45:AC75, AF45:AJ75, AM45:AQ75") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
Select Case Zelle.Text
Case "F"
Zelle.Interior.ColorIndex = 7 'Frühschicht
Case "S"
Zelle.Interior.ColorIndex = 6 'Spätschicht
Case "N"
Zelle.Interior.ColorIndex = 8 'Nachtschicht
Case ""
Zelle.Interior.ColorIndex = 0 'Weiss
Case "0"
Zelle.Interior.ColorIndex = 0 'Weiss
End Select
Next Zelle
Set Bereich = Range("D6:H36,D45:H75") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
If Weekday(Cells(Zelle.Row, 2)) = 1 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 2)) = 7 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 37
If Weekday(Cells(Zelle.Row, 2)) = 1 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 2)) = 7 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 38
If Weekday(Cells(Zelle.Row, 2)) = 1 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 2)) = 7 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 36
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 3)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 3)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 3)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 3)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 3)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 3)) > 1 Then Zelle.Interior.ColorIndex = 43
Next Zelle
Set Bereich = Range("r6:v36,r45:v75") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
If Weekday(Cells(Zelle.Row, 16)) = 1 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 16)) = 7 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 37
If Weekday(Cells(Zelle.Row, 16)) = 1 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 16)) = 7 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 38
If Weekday(Cells(Zelle.Row, 16)) = 1 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 16)) = 7 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 36
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 17)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 17)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 17)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 17)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 17)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 17)) > 1 Then Zelle.Interior.ColorIndex = 43
Next Zelle
Set Bereich = Range("K6:O33,K45:O75") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
If Weekday(Cells(Zelle.Row, 9)) = 1 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 9)) = 7 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 37
If Weekday(Cells(Zelle.Row, 9)) = 1 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 9)) = 7 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 38
If Weekday(Cells(Zelle.Row, 9)) = 1 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 9)) = 7 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 36
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
Next Zelle
Set Bereich = Range("K34:O34") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
'so dachte ich mirs
If Weekday(Cells(Zelle.Row, 9)) = "#Wert" And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = _
_
15
If Weekday(Cells(Zelle.Row, 9)) = 1 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 9)) = 7 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 37
If Weekday(Cells(Zelle.Row, 9)) = 1 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 9)) = 7 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 38
If Weekday(Cells(Zelle.Row, 9)) = 1 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 9)) = 7 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 36
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 10)) > 1 Then Zelle.Interior.ColorIndex = 43
Next Zelle
Set Bereich = Range("y6:ac36,y45:ac75") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
If Weekday(Cells(Zelle.Row, 23)) = 1 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 23)) = 7 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 37
If Weekday(Cells(Zelle.Row, 23)) = 1 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 23)) = 7 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 38
If Weekday(Cells(Zelle.Row, 23)) = 1 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 23)) = 7 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 36
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 24)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 24)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 24)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 24)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 24)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 24)) > 1 Then Zelle.Interior.ColorIndex = 43
Next Zelle
Set Bereich = Range("af6:aj36,af45:aj75") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
If Weekday(Cells(Zelle.Row, 30)) = 1 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 30)) = 7 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 37
If Weekday(Cells(Zelle.Row, 30)) = 1 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 30)) = 7 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 38
If Weekday(Cells(Zelle.Row, 30)) = 1 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 30)) = 7 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 36
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 31)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 31)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 31)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 31)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 31)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 31)) > 1 Then Zelle.Interior.ColorIndex = 43
Next Zelle
Set Bereich = Range("AM6:AQ36,AM45:AQ75") '= ActiveSheet.UsedRange
For Each Zelle In Bereich
If Weekday(Cells(Zelle.Row, 37)) = 1 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 37)) = 7 And Zelle.Text = "N" Then Zelle.Interior.ColorIndex = 37
If Weekday(Cells(Zelle.Row, 37)) = 1 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 37)) = 7 And Zelle.Text = "F" Then Zelle.Interior.ColorIndex = 38
If Weekday(Cells(Zelle.Row, 37)) = 1 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 15
If Weekday(Cells(Zelle.Row, 37)) = 7 And Zelle.Text = "S" Then Zelle.Interior.ColorIndex = 36
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 38)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "N" And Len(Cells(Zelle.Row, 38)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 38)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "F" And Len(Cells(Zelle.Row, 38)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 38)) > 1 Then Zelle.Interior.ColorIndex = 43
If Zelle.Text = "S" And Len(Cells(Zelle.Row, 38)) > 1 Then Zelle.Interior.ColorIndex = 43
Next Zelle
For Each Zelle In ActiveSheet.Range("B6:AQ36,B45:AQ75") 'funktioniert
If Zelle.Value = "F" Then
Zelle.Font.ColorIndex = 1 'schwarz
End If
If Zelle.Value = "S" Then
Zelle.Font.ColorIndex = 1 'schwarz
End If
If Zelle.Value = "N" Then
Zelle.Font.ColorIndex = 1 'schwarz
End If
If Zelle.Value = "0" Then
Zelle.Font.ColorIndex = 2 'weiss
End If
Next Zelle
'Selection.Offset(0, 1).Activate
[B2].Select
'End Sub
Application.Calculation = xlAutomatic
End Sub