Kalender

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

    Betrifft: Kalender
    von: Marcus
    Geschrieben am: 30.10.2003 11:52:21

    Hallo,

    ich habe folgendes Problem:

    Ich habe ein Makro aus dem Buch "VBA-Programmierung mit Excel 97" von Michael Kofler abgeschrieben, aber es funktioniert nicht.
    Es handelt sich um das Makro zur Kalenderberechnung ab S. 225.
    Leider läuft es nicht.

    Am einfachsten ist wohl, wenn ich einstelle!?
    Hier isses: Das Problem makiere ich durch XXX

    Function osterdatum(Jahr) As Date
    Dim ZR1%, ZR2%, ZR3%, ZR4%, ZR5%, ZR6%, ZR7%
    ZR1 = Jahr Mod 19 + 1
    ZR2 = Fix(Jahr / 100) + 1
    ZR3 = Fix(3 * ZR2 / 4) - 12
    ZR4 = Fix((8 * ZR2 + 5) / 25) - 5
    ZR5 = Fix(5 * Jahr / 4) - ZR3 - 10
    ZR6 = (11 * ZR1 + 20 + ZR4 - ZR3) Mod 30
    If (ZR6 = 25 And ZR1 > 11) Or ZR6 = 24 Then ZR6 = ZR6 + 1
    ZR7 = 44 - ZR6
    If ZR7 < 21 Then ZR7 = ZR7 + 30
    ZR7 = ZR7 + 7
    ZR7 = ZR7 - (ZR5 + ZR7) Mod 7
    If ZR7 <= 31 Then
    osterdatum = CDate(CStr(ZR7) & ". 3. " & CStr(Jahr))
    Else
    osterdatum = DateValue(CStr(ZR7 - 31) & ". 4. " & CStr(Jahr))
    End If
    End Function



    Dim berechnungsjahr
    Dim feierdatum() As Date, feiername() As String

    
    Private Sub Feiertagstabelle(Jahr)
    Dim ostern As Date
    Dim feiertage As Range, zeile As Range
    Dim linksoben As Range, rechtsunten As Range
    Dim ftab As Worksheet
    Dim i%
    If Not IsNumeric(Jahr) Then Exit Sub
    If Jahr < 1900 Or Jahr > 2078 Then Exit Sub
    If berechnungsjahr = Jahr Then Exit Sub
    ostern = osterdatum(Jahr)
    Set ftab = ThisWorkbook.Sheets("Tabelle Feiertage")
    Set linksoben = ftab.[A3]
    For i = 1 To 300
        If ftab.[d3].Offset(i, 0).Text = "" Then
            Set rechtsunten = ftab.[d3].Offset(i - 1, 0)
            Exit For
        End If
    Next
    Set feiertage = ftab.Range(linksoben, rechtsunten)
    ReDim feierdatum(feiertage.Rows.Count - 1)
    ReDim feiername(feiertage.Rows.Count - 1)
    i = 0
    For Each zeile In feiertage.Rows
        If zeile.Cells(3).Text <> "" Then
            feierdatum(i) = CDate(CDbl(ostern) + zeile.Cells(3))
        Else
            feierdatum(i) = DateSerial(Jahr, zeile.Cells(2), zeile.Cells(1))
        End If
        feiername(i) = zeile.Cells(4)
        i = i + 1
    Next zeile
    berechnungsjahr = Jahr
    End Sub
    

    End Sub

    Function Feiertag(ByVal datum As Date)
    Dim i%
    If Year(datum) <> berechnungsjahr Then
    Feiertagstabelle Year(datum)
    End If
    datum = CDate(Int(datum))

    XXXFor i = 0 To UBound(feierdatum()) ' feierdatum ist nicht definiert!!!!
    If datum = feierdatum(i) Then

    XXX Feiertag = feiername(i): Exit Function 'feiername auch nicht!
    End If
    Next
    Feiertag = ""
    End Function

    Sub Kalendererzeugen()
    Application.ScreenUpdating = False

    Dim Jahr, i%, Monat%, Tag%, f$
    Dim ws As Worksheet
    Dim start As Range
    Dim d As Date
    Jahr = InputBox("Für welches Jahr soll der Kalender erzeugt werden?")
    If Jahr = "" Or Not IsNumeric(Jahr) Then Exit Sub
    Set ws = Worksheets.Add()
    ws.Name = "Kalender " & Jahr
    ActiveWindow.DisplayGridlines = False
    Set start = ws.[A3]
    With start
    .Formula = Jahr
    .Font.Bold = True
    .Font.Size = 18
    .HorizontalAlignment = xlLeft
    End With
    With start.Offset(1, 0)
    For i = 1 To 12
    d = DateSerial(Jahr, i, 1)
    .Offset(0, i - 1).Formula = Format(d, "mmmm")
    Next
    End With
    With Range(start.Offset(1, 0), start.Offset(1, 11))
    .Font.Bold = True
    .Font.Size = 14
    .HorizontalAlignment = xlLeft
    .Borders(xlTop).Weight = xlThin
    .Borders(xlBottom).Weight = xlThin
    .Interior.ColorIndex = 15
    .Interior.Pattern = xlSolid
    .Interior.PatternColorIndex = 15
    .ColumnWidth = 15
    End With
    For Monat = 1 To 12
    For Tag = 1 To Day(DateSerial(Jahr, Monat + 1, 0))
    With start.Offset(Tag + 1, Monat - 1)
    d = DateSerial(Jahr, Monat, Tag)
    f = Feiertag(d)
    If f = "" Then
    .Value = Tag
    Else
    .Value = f
    End If
    If f <> "" Or Weekday(d) = 1 Or Weekday(d) = 7 Then
    .Font.Bold = True
    End If
    If Weekday(d) = 1 Or Weekday(d) = 7 Then
    .Interior.ColorIndex = 15
    .Interior.Pattern = xlSolid
    .Interior.PatternColorIndex = 15
    End If
    End With
    Next
    Next
    With Range(start.Offset(2, 0), start.Offset(32, 11))
    .HorizontalAlignment = xlLeft
    End With
    End Sub


    So stehts geschrieben!
    Es tut mir ja auch echt leid, dass diese Nachricht so lang geworden ist.
    Deshalb bedankte ich mich auch bei allen, die bis an diese Stelle gelesen haben!!!
    Danke!
    Für Hilfe bin noch dankbarer!
    Gruß
    Marcus
    Bild


    Betrifft: AW: Kalender
    von: Gert Seler
    Geschrieben am: 30.10.2003 13:00:13

    Hallo Marcus,
    die weiter oben stehenden DIM-Zeilen : Dim berechnungsjahr, Dim feierdatum() as Date,
    Dim feiername() as string
    gehören als Dim-Anweisung in die fehlerhafte "Function Feiertag(ByVal datum As Date)".
    In VBA kenne ich mich sonst nicht weiter aus.
    mfg
    Gert


    Bild


    Betrifft: AW: Kalender
    von: Marcus
    Geschrieben am: 30.10.2003 13:13:37

    Hi Gert,

    das wars leider nicht!

    Marcus


     Bild

    Beiträge aus den Excel-Beispielen zum Thema " Kalender"