Hilfe bei folgendem Code

• Hilfe bei folgendem Code von Martin B vom 19.11.2003 19:43:17
  • AW: Hilfe bei folgendem Code - von andre am 19.11.2003 20:05:05
    • AW: Danke Andre, für die schnelle Hilfe - von Martin B am 19.11.2003 20:09:19

Betrifft: Hilfe bei folgendem Code
von: Martin B
Geschrieben am: 19.11.2003 19:43:17
Hallo Leute,

Kann mir jemand bei folgendem Code behilflich sein?
Ich möchte das in meiner tabelle auch der 1 bis 4 Advent
und der Buß & Bettag eingetragen wird. Ich habe schon viel versucht es umzuschreiben bekomme es aber nicht hin.
Auch gebe ich zu das dieser Code nicht von mir ist, leider bin ich kein so großer Profi.
Ich hoffe es kann mir jemand helfen, vielen Dank schon im voraus.

Sub Start()
ErstIndex = True
Color = 40 'Farbcode für freie Tage
Sheets("Kalender").Select
JJJJ = Val(InputBox("Bitte das gewünschte Jahr (JJJJ) eingeben", "Jahreseingabe"))
If JJJJ = 0 Then Exit Sub
If JJJJ < 1900 Then
MsgBox "Jahr muß >= 1900 sein"
Exit Sub
End If
Application.ScreenUpdating = False
Cells(1, 1) = JJJJ
'Löschen der bisherigen variablen Inhalte
Range("b4:ak34").Interior.ColorIndex = xlNone
For t = 2 To 36 Step 3
Range(Cells(4, t + 2), Cells(34, t + 2)).ClearContents
Next t
If (Cells(1, 1) Mod 4) = 0 Then
Cells(31, 6).Copy Cells(32, 6)
Else
Cells(32, 6) = ""
End If
'Setzen der Hintergrundfarben und Texte für freie Tage und sonstige Feiertage
Ostern = OsterSonntag(JJJJ)
For z = 4 To 34
For t = 4 To 34
For s = 3 To 36 Step 3
WT = Weekday(Cells(z, s))
Zellenwert = Cells(z, s)
If IsEmpty(Cells(z, s)) Then
GoTo Nächste_stz
End If
'Wochenende
Select Case WT
Case 1
With Range(Cells(z, s + 1), Cells(z, s)).Interior
.ColorIndex = 38
.Pattern = xlSolid
End With
End Select
Select Case WT
Case 7
With Range(Cells(z, s + 1), Cells(z, s)).Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
End Select
'Feiertage
Select Case Zellenwert
'Bewegliche Feiertage "für Fronleichnam gilt Ostern + 60"
Case Ostern - 2
Beschriftung = "Karfreitag"
AF = 1
Feiertag
Case Ostern
Beschriftung = "Ostersonntag"
AF = 1
Feiertag
Case Ostern + 1
Beschriftung = "Ostermontag"
AF = 1
Feiertag
Case Ostern + 39
Beschriftung = "Chr.Himmelfahrt"
AF = 1
Feiertag
Case Ostern + 50
Beschriftung = "Pfingstmontag"
AF = 1
Feiertag
Case Ostern - 46
Beschriftung = "Aschermittwoch"
AF = 0
Feiertag
Case Ostern - 48
Beschriftung = "Rosenmontag"
AF = 0
Feiertag
'Feste Feiertage
Case DateSerial(JJJJ, 1, 1)
Beschriftung = "Neujahr"
AF = 1
Feiertag
Case DateSerial(JJJJ, 5, 1)
Beschriftung = "Maifeiertag"
AF = 1
Feiertag
Case DateSerial(JJJJ, 10, 3)
Beschriftung = "Tag der Einheit"
AF = 1
Feiertag
Case DateSerial(JJJJ, 10, 31)
Beschriftung = "Reformationstag"
AF = 1
Feiertag
Case DateSerial(JJJJ, 12, 25)
Beschriftung = "1.Weihnachtstag"
AF = 1
Feiertag
Case DateSerial(JJJJ, 12, 26)
Beschriftung = "2.Weihnachtstag"
AF = 1
Feiertag
Case DateSerial(JJJJ, 12, 24)
Beschriftung = "Hl.Abend"
AF = 0
Feiertag
Case DateSerial(JJJJ, 12, 31)
Beschriftung = "Silvester"
AF = 0
Feiertag
End Select
Nächste_stz:
Next s
Next t
Next z
Application.ScreenUpdating = True
Range("B4").Select
ErstIndex = False
End Sub

Betrifft: AW: Hilfe bei folgendem Code
von: andre
Geschrieben am: 19.11.2003 20:05:05
hallo martin,
schreib untendrunter die Funktion

Public

Function Busstag(ByVal Jahr As String)
'Buss- und Bettag: 11 Tage vor 1. Advent
Dim Weihnacht1 As Date, Advent1 As Date, Totensonntag As Date
Weihnacht1 = CDate("25.12." & Jahr)
Advent1 = Weihnacht1 - 21
While WeekDay(Advent1) <> vbSunday
Advent1 = Advent1 - 1
Wend
Totensonntag = Advent1 - 7
Busstag = Totensonntag - 4
End Function

bei den cases dann

Case Busstag(2003)
Beschriftung = "Busstag"
AF = 1
Feiertag

und für die advents

Case Busstag(2003)+11
Beschriftung = "1.Advent"
AF = 1
Feiertag

usw.

gruss andre

Betrifft: AW: Danke Andre, für die schnelle Hilfe
von: Martin B
Geschrieben am: 19.11.2003 20:09:19
.

Excel-Beispiele zum Thema " Hilfe bei folgendem Code"
Ordnerdialog mit nachfolgendem Dateidialog aufrufen