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.
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