|
Hallo zusammen
Bei folgenden VBA Code suche ich eine Funktion die mir vor Allem den ersten des Monats speziell kennzeichnet...
Sub Jahreeskalender()
Dim Tag As Integer, Monat As Integer, Jahr As Integer
Dim Datum As Date, DatumErster As Date
Dim AnzahlTage As Integer
Jahr = Application.InputBox("Bitte ein Jahr eingeben:" _
, Type:=1)
Monat = Application.InputBox("Bitte Monat eingeben:" _
, Type:=1)
ThisWorkbook.Worksheets("Tabelle1").Activate
DatumErster = DateSerial(Jahr, Monat, 1)
AnzahlTage = Day(Application.WorksheetFunction. _
EoMonth(DatumErster, 0))
For Tag = 1 To AnzahlTage
Datum = DateSerial(Jahr, Monat, Tag)
Cells(Tag, 1).Value = Datum
Cells(Tag, Monat).NumberFormatLocal = "TT.MM.JJ"
If Weekday(Datum) = 6 Then
Cells(Tag, 2).Interior.Color = vbRed
Cells(Tag, 3).Interior.Color = vbRed
Cells(Tag, 4).Interior.Color = vbRed
Cells(Tag, 5).Interior.Color = vbRed
Cells(Tag, 6).Interior.Color = vbRed
Cells(Tag, 7).Interior.Color = vbRed
Cells(Tag, 8).Interior.Color = vbRed
Cells(Tag, 9).Interior.Color = vbRed
Cells(Tag, 10).Interior.Color = vbRed
Cells(Tag, 11).Interior.Color = vbRed
Cells(Tag, 12).Interior.Color = vbRed
ElseIf Weekday(Datum) = 7 Then
Cells(Tag, 2).Interior.Color = vbRed
Cells(Tag, 3).Interior.Color = vbRed
Cells(Tag, 4).Interior.Color = vbRed
Cells(Tag, 5).Interior.Color = vbRed
Cells(Tag, 6).Interior.Color = vbRed
Cells(Tag, 7).Interior.Color = vbRed
Cells(Tag, 8).Interior.Color = vbRed
Cells(Tag, 9).Interior.Color = vbRed
Cells(Tag, 10).Interior.Color = vbRed
Cells(Tag, 11).Interior.Color = vbRed
Cells(Tag, 12).Interior.Color = vbRed
ElseIf Weekday(Datum) = 1 Then
Cells(Tag, 8).Interior.Color = vbRed
Cells(Tag, 9).Interior.Color = vbRed
Cells(Tag, 10).Interior.Color = vbRed
Cells(Tag, 11).Interior.Color = vbRed
ElseIf Weekday(Datum) = 2 Then
Cells(Tag, 8).Interior.Color = vbRed
Cells(Tag, 9).Interior.Color = vbRed
Cells(Tag, 11).Interior.Color = vbRed
ElseIf Weekday(Datum) = 3 Then
Cells(Tag, 8).Interior.Color = vbRed
Cells(Tag, 9).Interior.Color = vbRed
Cells(Tag, 10).Interior.Color = vbRed
ElseIf Weekday(Datum) = 4 Then
Cells(Tag, 8).Interior.Color = vbRed
Cells(Tag, 10).Interior.Color = vbRed
Cells(Tag, 11).Interior.Color = vbRed
ElseIf Weekday(Datum) = 5 Then
Cells(Tag, 8).Interior.Color = vbRed
Cells(Tag, 9).Interior.Color = vbRed
Cells(Tag, 10).Interior.Color = vbRed
Cells(Tag, 11).Interior.Color = vbRed
End If
Next Tag
End Sub
Vielen Dank Für eure Hilfe!
|