HERBERS Excel-Forum - die Beispiele

Thema: Jahreskalender und bedingte Formatierung

Home

Gruppe

Format

Problem

Wie kann ich ein Jahreskalenderblatt anlegen und Wochenenden, den aktuellen Tag und Feiertage farblich markieren, ohne VBA einzusetzen? Bei Eingabe eines neuen Jahres soll eine Neuberechnung erfolgen.

Lösung
Nur anhand einer Beipspielarbeitsmappe darstellbar.
StandardModule: basMain

Sub Main()
   Dim wks As Worksheet
   Dim cmt As Comment
   Dim vYear As Variant
   Dim iRow As Integer
   Dim bln As Boolean
   Application.ScreenUpdating = False
   bln = Application.DisplayStatusBar
   Application.DisplayStatusBar = True
   Application.DisplayCommentIndicator = xlCommentIndicatorOnly
   Set wks = ActiveSheet
   vYear = InputBox( _
      prompt:="Gewünschtes Kalenderjahr angeben:", _
      Default:=Year(Date))
   Range("C1").Value = CInt(vYear)
   Workbooks.Add 1
   Call MonateAnlegen
   Call TageEintragen
   iRow = 1
   Do Until IsEmpty(wks.Cells(iRow, 1))
      With Worksheets(Month(wks.Cells(iRow, 2).Value))
         With .Cells(Day(wks.Cells(iRow, 2).Value), 1)
            .Interior.ColorIndex = 36
            Set cmt = .AddComment(wks.Cells(iRow, 1).Value)
            cmt.Shape.TextFrame.AutoSize = True
         End With
      End With
      iRow = iRow + 1
   Loop
   Application.DisplayStatusBar = bln
   Application.StatusBar = False
   Application.ScreenUpdating = True
End Sub

Private Sub MonateAnlegen()
   Dim iMonth As Integer
   For iMonth = 1 To 12
      If iMonth > 1 Then
         Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
      End If
      ActiveSheet.Name = Format( _
         DateSerial(Range("C1").Value, iMonth, 1), "mmmm")
   Next iMonth
End Sub

Private Sub TageEintragen()
   Dim wks As Worksheet, wksMy As Worksheet
   Dim lDay As Long
   Dim iMonth As Integer, iDay As Integer
   Set wksMy = ThisWorkbook.Worksheets("Feiertage")
   For iMonth = 1 To 12
      Set wks = Worksheets(iMonth)
      Application.StatusBar = "Bearbeite Monat " & wks.Name
      wks.Columns(1).NumberFormat = "dd.mm.yy"
      wks.Columns(2).NumberFormat = "dddd"
      For lDay = DateSerial(wksMy.Range("C1").Value, iMonth, 1) To _
         DateSerial(wksMy.Range("C1").Value, iMonth + 1, 0)
         iDay = iDay + 1
         wks.Cells(iDay, 1) = lDay
         wks.Cells(iDay, 2) = lDay
         If WeekDay(lDay) = 7 Then
            wks.Cells(iDay, 1).Interior.ColorIndex = 34
            wks.Cells(iDay, 2).Interior.ColorIndex = 34
         ElseIf WeekDay(lDay) = 1 Then
            wks.Cells(iDay, 1).Interior.ColorIndex = 35
            wks.Cells(iDay, 2).Interior.ColorIndex = 35
         End If
      Next lDay
      iDay = 0
    Next iMonth
    Worksheets(1).Select
    ActiveWindow.Caption = "Jahreskalender " & wksMy.Range("C1").Value
End Sub

StandardModule: basFunction

Function Ostern(iYear As Integer)
   Dim iDay As Integer
   iDay = (((255 - 11 * (iYear Mod 19)) - 21) Mod 30) + 21
   Ostern = DateSerial(iYear, 3, 1) + iDay + (iDay > 48) + _
      6 - ((iYear + iYear \ 4 + iDay + (iDay > 48) + 1) Mod 7)
End Function

Beiträge aus dem Excel-Forum zu den Themen Format und DatumUndZeit

Bedingte Formatierung vor Copy/Paste schützen Bed. Formatierung, wenn alle Beding. erfüllt.
Telefonnummer automatisch per VBA formatieren Komplettes Excel Sheet kopieren mit Formaten
Bedingte Formatierung per VBA mit Schleife Kartendiagramm per VBA erstellen und formatieren
bedingte Formatierung Zellfarbe per Cond Formatting nach Zellfarbe änder
UserForm im Querformat drucken Bedingte Formatierung
Teilstringabfrage bei bedingter Formatierung Bedingte Formatierung mit UND Verknüpfung
Textformat (VBA) Bedingte Formatierung Frage
Array in Tabelle kopieren, Verlust von Format Übernahme in Word Format wird nicht übernommen
VBA, 4 Informationen in 4 Zellen schreiben bedingte Formatierung mit mehreren Bedingungen
Datum aus Oracle-Abfrage als Datum formatieren Bedingte Formattierung
Bedingte Formatierung - kleiner als Fehler Zahlenformat Handynr.
Diagramme und ihr Format bedingte formatierung per VBA
Bedingte Formatierung bezogen auf 2. Zelle Formatgleichheit von Zeichenfolgen für SVERWEIS
bedingte Formatierung Bedingte Formatierung
Tabellen - Zellen - Formatieren - Format übertragen
Datumsformatierung Formatierung anderer Diagramme
Zellenformatierung speichern Diagrammformatierung übertragen
Zahlenformat global überprüfen wenn z.B. Zahl 12 dann grün (Bedingte Formatierung
wenn z.B. Zahl 12 dann grün (Bedingte Formatierung Zahlenformatierung in einem Textfeld
Zahlenformat bedingte Formatierung für zellenbereich
Format Datum / Uhrzeit Eilt - Formatierung "in 1000"
Bedingte Formatierung mit 2 Bedingungen Combobox, CheckBox, TextBox Formatierung
Formatierung Dezimalzahlen bei Combobox-Eingaben Dateiformat vorgeben
Datums-Format bei Verketten "falsch" Text mit Format in Textbox übertragen
Format mit VBA kopieren