Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hilfe bei folgendem Code

Forumthread: Hilfe bei folgendem Code

Hilfe bei folgendem Code
19.11.2003 19:43:17
Martin B
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

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe bei folgendem Code
19.11.2003 20:05:05
andre
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
Anzeige
AW: Danke Andre, für die schnelle Hilfe
19.11.2003 20:09:19
Martin B
.
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige