Re: klar doch...oT
12.01.2003 15:21:02
RoDiMa
Hallo,
hier der Code; ist allerdings auch nicht auf mein Wissen zurückzuführen.
Es soll hiermit ein Kalender autom. mit den Fehlzeitenkürzeln(U,k,usw.) für den Zeitraum von-bis eingetragen werden.Option Explicit
Dim iZeile%, iSpalte%, LastCol%, iTag%, Blatt$
Private Sub CmbDateneintragen_Click()
Dim Vom As Date, Bis As Date, LbTag%, i%
Dim Blatt1 As Worksheet, BlattN As Worksheet, Blatt2 As Worksheet
Set Blatt1 = Worksheets(Month(TbVom) + 1)
Set Blatt2 = Worksheets(Month(TbBis) + 1)
iZeile = Blatt1.Columns(1).Find(ComboMA).Row
If Month(TbVom) <> Month(TbBis) Then
iSpalte = Day(TbVom) + 1
LastCol = Blatt1.Cells(2, Columns.Count).End(xlToLeft).Column
Farbe (Blatt1.Name)
i = 1
Do Until Blatt1.Index + i = Blatt2.Index
Set BlattN = Worksheets(Blatt1.Index + i)
iSpalte = 2
LastCol = BlattN.Cells(2, Columns.Count).End(xlToLeft).Column
Farbe (BlattN.Name)
i = i + 1
Loop
iSpalte = 2
LastCol = Day(TbBis) + 1
Farbe (Blatt2.Name)
Else
iSpalte = Day(TbVom) + 1
LastCol = Day(TbBis) + 1
Farbe (Blatt1.Name)
End If
End Sub
Sub Farbe(Blatt)
For iSpalte = iSpalte To LastCol
iTag = Weekday(Worksheets(Blatt).Cells(2, iSpalte), vbMonday)
If Worksheets(Blatt).Cells(100, iSpalte) <> 2 Then
If iTag = LbTage.ListIndex Or LbTage.ListIndex = 0 Then
If ComboArt = "LÖSCHEN" Then
Worksheets(Blatt).Cells(iZeile, iSpalte) = ""
Else
Worksheets(Blatt).Cells(iZeile, iSpalte) = ComboArt
With Worksheets(Blatt).Cells(iZeile, iSpalte).Font
.Bold = True
Select Case ComboArt
Case "U"
.ColorIndex = 10
Case "k"
.ColorIndex = 3
Case "aA"
.ColorIndex = 43
Case "AA"
.ColorIndex = 32
Case "AD"
.ColorIndex = 51
Case "B"
.ColorIndex = 14
Case "D"
.ColorIndex = 41
Case "F"
.ColorIndex = 20
Case Else
.ColorIndex = 1
End Select
End With
End If
End If
End If
Next
End Sub
Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub