Kalender erstellen mit VBA

3 Antworten

Vom Fragesteller als hilfreich ausgezeichnet

So läuft es:

    Private Sub Kalender_Click()

Dim ws As Worksheet
Dim strMeldung As String
Dim strTitel As String
Dim strAntwort As String
Dim varYear As Variant
Dim bytMonth As Byte
Dim bytDay As Byte
Dim bytWeekday As Byte
Dim strWeekday As String
Dim bytWeeknumber As Byte
Dim bytDummy As Byte

' Das Jahr des Kalenders der ausgegeben werden soll

strMeldung = "Geben Sie das Jahr ein!"
strTitel = "Eingabe Jahr"

strAntwort = InputBox(strMeldung, strTitel)
varYear = strAntwort

' Falls bereits ein Blatt mit dem Namen "Jahr xxxx" entsteht, ' soll dieses gelöscht werden
For Each ws In Worksheets
If ws.Name = "Jahr " & varYear Then ws.Delete
Next ws
' Ein neues Tabellenblatt mit dem Namen "Jahr xxxx" einfügen
Worksheets.Add
ActiveSheet.Name = "Jahr " & varYear

' Monatsüberschriften einfügen und formatieren

For bytMonth = 1 To 12
Cells(1, bytMonth) = bytMonth ' Monatszahl in Zeile 1
  'With Worksheets("Kalender")
     '.Range("A1:L35") = Worksheets("Kalender")
     '.Cells = "bytMonth"
     '.Value = Format(DateSerial(varYear, bytMonth, 1), "mmmm")
     '.Interior.ColorIndex = 36
     '.Font.Bold = True
  'End With
  
  ' Tage aufbereiten
  For bytDay = 1 To Day(DateSerial(varYear, bytMonth + 1, 0))
     With Cells(bytDay + 1, bytMonth)
       bytWeekday = Weekday(DateSerial(varYear, bytMonth, bytDay))
       
       ' Wochentage in Textformat aufbereiten
       Select Case bytWeekday
          Case 1
             strWeekday = "So"
          Case 2
             strWeekday = "Mo"
          Case 3
             strWeekday = "Di"
          Case 4
             strWeekday = "Mi"
          Case 5
             strWeekday = "Do"
          Case 6
             strWeekday = "Fr"
          Case 7
             strWeekday = "Sa"
       End Select
       
       ' Wochentage und Tage eintragen
       .Value = strWeekday & ", " & bytDay
       ' Samstage hellgrau hervorheben
       If bytWeekday = 7 Then
          .Interior.ColorIndex = 15
       End If
       
       ' Sonntage dunkelgrau hervorheben
       If bytWeekday = 1 Then
          .Interior.ColorIndex = 48
       End If
       ' Kalenderwoche eintragen
       bytWeeknumber = _
          Format(DateSerial(varYear, bytMonth, bytDay), "ww")
       If bytDummy < bytWeeknumber And strWeekday <> "So" Then
          bytDummy = bytWeeknumber
          .Value = .Value & " (" & bytDummy & ")"
          ' Formatierung Kalenderwoche >ZWEI FARBEN IN EINER ZELLE
          With .Characters _
               (Start:=InStr(1, .Value, "("), Length:=4).Font
             .Size = 8
             .Color = vbRed
          End With
       End If
     End With
  Next bytDay

Next bytMonth
End Sub

Einige Änderungen:
Name des TabBl (Active Sheet.Name ...)
Monatszahl in Zeile 1
Range("A1:L35") von Oubyi richtig bemerkt
'With Worksheets("Kalender")... als Kommentar

Sieht zwar nicht toll aus, aber funktioniert.

Gruß aus Berlin

Woher ich das weiß:Hobby – Jahrelanges programmieren.

Liteon 
Fragesteller
 12.12.2013, 21:57

Kannst du mir noch helfen es so umzubauen das Feiertage (Sachsen) und Termine (Schulungen,Urlaub) die ich selbst festlegen kann, eingetragen werden.Quasi das ich sie in einer Tabelle eintrage und sie wie Wochenende Markiert werden.Wäre dir sehr dankbar dafür.

0
Britzcontrol  13.12.2013, 06:54
@Liteon

Das wäre dann eine umfangreiche Programmierarbeit und überschritte eindeutig den Sinn einer "guten Frage".
Hier werden Fragen beantwortet, keine Programme erstellt.

Du müsstest Deine Ferien/Feiertagsdaten eintragen,
Lesen kann man sie dann mit: Feiertag1 = Cells(Zeile,Spalte)
schreiben mit: Cells(Zeile, Spalte) = Feiertag1 usw.

Gruß aus Berlin

0

Quelltext ist hier: Private Sub Kalender_Click()

Dim ws As Worksheet Dim strMeldung As String Dim strTitel As String Dim strAntwort As String Dim varYear As Variant Dim bytMonth As Byte Dim bytDay As Byte Dim bytWeekday As Byte Dim strWeekday As String Dim bytWeeknumber As Byte Dim bytDummy As Byte

' Das Jahr des Kalenders der ausgegeben werden soll

strMeldung = "Geben Sie das Jahr ein!" strTitel = "Eingabe Jahr"

strAntwort = InputBox(strMeldung, strTitel) varYear = strAntwort

' Falls bereits ein Blatt mit dem Namen "Jahr xxxx" entsteht, ' soll dieses gelöscht werden For Each ws In Worksheets If ws.Name = "Jahr " & varYear Then ws.Delete End If Next ws

' Ein neues Tabellenblatt mit dem Namen "Jahr xxxx" einfügen Worksheets.Add ActiveSheet.Name = "Kalender"

' Monatsüberschriften einfügen und formatieren

For bytMonth = 1 To 12

  With Worksheets("Kalender").Range("A1;L35") = Worksheets("Kalender").Cells = "bytMonth"
     .Value = Format(DateSerial(varYear, bytMonth, 1), "mmmm")
     .Interior.ColorIndex = 36
     .Font.Bold = True
  End With
  
  ' Tage aufbereiten
  For bytDay = 1 To Day(DateSerial(varYear, bytMonth + 1, 0))
     With Cells(bytDay + 1, bytMonth)
       bytWeekday = Weekday(DateSerial(varYear, bytMonth, bytDay))
       
       ' Wochentage in Textformat aufbereiten
       Select Case bytWeekday
          Case 1
             strWeekday = "So"
          Case 2
             strWeekday = "Mo"
          Case 3
             strWeekday = "Di"
          Case 4
             strWeekday = "Mi"
          Case 5
             strWeekday = "Do"
          Case 6
             strWeekday = "Fr"
          Case 7
             strWeekday = "Sa"
       End Select
       
       ' Wochentage und Tage eintragen
       .Value = strWeekday & ", " & bytDay
       ' Samstage hellgrau hervorheben
       If bytWeekday = 7 Then
          .Interior.ColorIndex = 15
       End If
       
       ' Sonntage dunkelgrau hervorheben
       If bytWeekday = 1 Then
          .Interior.ColorIndex = 48
       End If
       ' Kalenderwoche eintragen
       bytWeeknumber = _
          Format(DateSerial(varYear, bytMonth, bytDay), "ww")
       If bytDummy < bytWeeknumber And strWeekday <> "So" Then
          bytDummy = bytWeeknumber
          .Value = .Value & " (" & bytDummy & ")"
          ' Formatierung Kalenderwoche
          With .Characters _
               (Start:=InStr(1, .Value, "("), Length:=4).Font
             .Size = 8
             .Color = vbRed
          End With
       End If
     End With
  Next bytDay

Next bytMonth End Sub


Oubyi, UserMod Light  09.12.2013, 12:23

Auf jeden Fall ist das Semikolon in der Range-Anweisung FALSCH, die muss lauten:
Range("A1:L35")
Also mit Doppelpunkt.
Außerdem verstehe ich nicht, was der Teil:
... = Worksheets("Kalender").Cells = "bytMonth"
im KOPF der With-Anweisung zu suchen hat.
Den Rest habe ich mir noch nicht weiter angesehen.

0

Brauche schnellstmöglich Hilfe denn Sitz an diesen kleinen eigenen Projekt schon über ne Woche und es ist immer so hiermal eine kleine Ecke und dort mal eine Ecke.Aber es findet irgendwie nicht ganz zusammen.Ich setze nun einen großen Teil meiner Hoffnung auf euch (Werd nätürlich weiter "tüffteln") aber denke zusammen können wir es schaffen :D.