Aus einem Code vom Forum habe ich folgenden Code erstellt.
Nun möchte ich die Monate ausschreiben. Mit
Cells(Start, x) = Format(Start, "00") & ". " & Format(x, "mmmm") & " " & Jahr & " " & Kürzel
erhalte ich immer den Januar. Welches Format muss ich sezten?
Kann dieser Code evt. vereinfacht werden?
Vielen Dank und Gruss
Gregor
Sub Jahr_erstellen() Application.ScreenUpdating = False Application.EnableEvents = False usrJahr.Show Wahl = False Range(Cells(1, 1), Cells(31, 12)).ClearContents Range(Cells(1, 1), Cells(31, 12)).ClearFormats For x = 1 To 12 AnzTage = DaysOfMonth(Jahr, x) For Start = 1 To AnzTage Kürzel = Format(Weekday(Start & "." & x & "." & Jahr, 1), "ddd") Wahl = Feiertag(Start & "." & x & "." & Jahr) If Wahl Then Cells(Start, x) = Format(Start, "00") & ". " & Format(x, "00") & " " & Jahr & " _ " & Kürzel & Text Cells(Start, x).Interior.ColorIndex = 7 ElseIf Kürzel = "So" Then Cells(Start, x) = Format(Start, "00") & ". " & Format(x, "00") & " " & Jahr & " _ " & Kürzel Cells(Start, x).Interior.ColorIndex = 22 ElseIf Kürzel = "Sa" Then Cells(Start, x) = Format(Start, "00") & ". " & Format(x, "00") & " " & Jahr & " _ " & Kürzel Cells(Start, x).Interior.ColorIndex = 17 Else Cells(Start, x) = Format(Start, "00") & ". " & Format(x, "00") & " " & Jahr & " _ " & Kürzel End If Next Next x Columns("A:L").AutoFit Unload usrJahr Application.ScreenUpdating = True Application.EnableEvents = True End Sub
Function DaysOfMonth(ByVal Year As Long, ByVal Month As Long) As Long
DaysOfMonth = Day(DateSerial(Jahr, x + 1, 0))
End Function
Function Feiertag(Dat As Date) As Boolean
Dim m As Integer, d As Integer, y As Integer
Dim ost As Date
Dim dd As Integer
m = x
d = Start
y = Jahr
dd = (((255 - 11 * (y Mod 19)) - 21) Mod 30) + 21
ost = DateSerial(y, 3, 1) + dd + (dd > 48) + _
6 - ((y + y \ 4 + dd + (dd > 48) + 1) Mod 7)
'bewegliche Feiertage
Select Case Dat
Case ost
Feiertag = True
Text = " Ostern"
Case ost + 1
Feiertag = True
Text = " Ostermontag"
Case ost - 2
Feiertag = True
Text = " Karfreitag"
Case ost + 39
Feiertag = True
Text = " Auffahrt"
Case ost + 50 - 1
Feiertag = True
Text = " Pfingsten"
Case ost + 50
Feiertag = True
Text = " Pfingstmontag"
Exit Function
End Select
'feste Feiertage:
If d = 1 And m = 1 Then
Feiertag = True
Text = " Neujahr"
ElseIf d = 2 And m = 1 Then
Feiertag = True
Text = " Berchtoldstag"
ElseIf d = 1 And m = 8 Then
Feiertag = True
Text = " 1. August"
ElseIf d = 25 And m = 12 Then
Feiertag = True
Text = " Weihnachten"
ElseIf d = 26 And m = 12 Then
Feiertag = True
Text = " Stephanstag"
End If
End Function