Kalender erstellen mit VBA
Ich stehe grad auf dem Schlauch und würde mich wirklich sehr über aussagekraftige Antworten freuen.Ich würde gern einen Kalender erstellen mit VBA in Ecxel in den ich mit einen Commandbutton einen Kalender erstellen kann und dieser dir Wochentag,Monat und so weiter anzeigt aber du auch in einer Tabelle z.B. Urlaub eintragen kannst und er dir das gleich mit im Kalender anzeigt wenn er erstellt wird.Habe schon ein wenig Quellcode zusammengeschrieben es kommt aber immer Laufzeitfehler 1004 Anwender- oder opjektdefinierter Fehler der Debugger sagt mir es wäre etwas an der Zeile: With Worksheets("Kalender").Range("A1;L35") = Worksheets("Kalender").Cells = "bytMonth" falsch.
3 Antworten
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
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
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
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.
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.
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.