Hilfe bei folgendem Code

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

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

Bild


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


Bild


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

.


Bild

Beiträge aus den Excel-Beispielen zum Thema " Hilfe bei folgendem Code"