Kalender

  • Excel

Es gibt 17 Antworten in diesem Thema. Der letzte Beitrag () ist von bloodking.

    Kalender

    Hi ihrs ich habe jetzt einen Kalender programmiert der mir in Excel nach einer Eingabe des Jahres mir den Kalender generiert. Nur schreibt der Kalender jetzt jeden Monat von unten nach oben und wechselt dann am Ende des Monats und macht dann das gleiche.und ich will das er diese in einer bestimmten zeile sortiert und das dann darstellt denn ich will so ne art urlaubskalender automatisieren

    Meine frage jetzt wie muss ich das progamm modifizieren weil ich leider gerade wirklich aufm schlauch stehe?

    Quellcode

    1. Option Explicit
    2. Sub Jahreskalender()
    3. Dim ws As Worksheet
    4. Dim strMeldung As String
    5. Dim strTitel As String
    6. Dim strAntwort As String
    7. Dim varYear As Variant
    8. Dim bytMonth As Byte
    9. Dim bytDay As Byte
    10. Dim bytWeekday As Byte
    11. Dim strWeekday As String
    12. Dim bytWeeknumber As Byte
    13. Dim bytDummy As Byte
    15. ' Das Jahr des Kalenders der ausgegeben werden soll
    17. strMeldung = "Geben Sie das Jahr ein!"
    18. strTitel = "Eingabe Jahr"
    20. strAntwort = InputBox(strMeldung, strTitel)
    21. varYear = strAntwort
    23. ' Falls bereits ein Blatt mit dem Namen "Jahr xxxx" entsteht,
    24. ' soll dieses gelöscht werden
    25. For Each ws In Worksheets
    26. If ws.Name = "Jahr " & varYear Then
    27. ws.Delete
    28. End If
    29. Next ws
    31. ' Ein neues Tabellenblatt mit dem Namen "Jahr xxxx" einfügen
    32. Worksheets.Add
    33. ActiveSheet.Name = "Jahr " & varYear
    35. ' Monatsüberschriften einfügen und formatieren
    36. For bytMonth = 1 To 12
    37. With Cells(1, bytMonth)
    38. .Value = Format(DateSerial(varYear, bytMonth, 1), "mmmm")
    39. .Interior.ColorIndex = 36
    40. .Font.Bold = True
    41. End With
    43. ' Tage aufbereiten
    44. For bytDay = 1 To Day(DateSerial(varYear, bytMonth + 1, 0))
    45. With Cells(bytDay + 1, bytMonth)
    46. bytWeekday = Weekday(DateSerial(varYear, bytMonth, bytDay))
    48. ' Wochentage in Textformat aufbereiten
    49. Select Case bytWeekday
    50. Case 1
    51. strWeekday = "So"
    52. Case 2
    53. strWeekday = "Mo"
    54. Case 3
    55. strWeekday = "Di"
    56. Case 4
    57. strWeekday = "Mi"
    58. Case 5
    59. strWeekday = "Do"
    60. Case 6
    61. strWeekday = "Fr"
    62. Case 7
    63. strWeekday = "Sa"
    64. End Select
    66. ' Wochentage und Tage eintragen
    67. .Value = strWeekday & ", " & bytDay
    68. ' Samstage hellgrau hervorheben
    69. If bytWeekday = 7 Then
    70. .Interior.ColorIndex = 15
    71. End If
    73. ' Sonntage dunkelgrau hervorheben
    74. If bytWeekday = 1 Then
    75. .Interior.ColorIndex = 48
    76. End If
    77. ' Kalenderwoche eintragen
    78. bytWeeknumber = _
    79. Format(DateSerial(varYear, bytMonth, bytDay), "ww")
    80. If bytDummy < bytWeeknumber And strWeekday <> "So" Then
    81. bytDummy = bytWeeknumber
    82. .Value = .Value & " (" & bytDummy & ")"
    83. ' Formatierung Kalenderwoche
    84. With .Characters _
    85. (Start:=InStr(1, .Value, "("), Length:=4).Font
    86. .Size = 8
    87. .Color = vbRed
    88. End With
    89. End If
    90. End With
    91. Next bytDay
    92. Next bytMonth
    93. End Sub

    Ich habe den Kalender geschrieben auch wenn mit viel Hilfe die in einem Excel-Buch war ;) Dieser Kalender sortiert die Monate einzelnd und schreibt die verschiedenen Tage unter den Monat also von oben nach unten und das für jeden Monat neu. Nun will ich eben wissen wie ich das Programm so umschreiben könnte das er die tage mir von links nach rechts darstellt anstatt von oben nach unten und da brauch ich denkanstöße weil ich hänge da gerade fest

    Indem du an den zwei Stellen, wo du die Cells-Objekte adressierst die Parameter für Zeilen und Spalten vertauschst.

    Noch eine Anmerkung:
    Da wo du "With Cells" verwendest solltest du dringend das Worksheet mit angeben.
    Sinnvollerweise speicherst du dir das Sheet-Objekt gleich beim Erzeugen ab:

    Visual Basic-Quellcode

    1. Set YearSheet = Worksheets.Add
    2. YearSheet.Name="Jahr " & varYear
    3. ...
    4. With YearSheet.Cells(bytMonth, 1)
    5. ...
    6. With YearSheet.Cells(bytMonth, bytDay + 1)
    7. ...

    Vermeide die Verwendung von "ActiveSheet", sonst bist du immer davon abhängig, was Excel gerade als aktives Arbeitsblatt anzusehen glaubt.
    Und das kann sogar (kontextabhängig) von Version zu Version wechseln!
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    ok danke das funktioniert jetzt müsste ich nur noch hinkriegen das die monate nebeneinander sind und das überlege ich gerade außer einer kann mir da nen entscheidenen tipp geben ;)

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „bloodking“ ()

    ist als anhang dran und das war manuell erstellt.



    so ähnlich aber so krass muss das nicht sein weil ich nur anfängerskillz habe :)



    meine gedanken sind die das ich die kalenderwochen und die tage in eine range packe und dann er das so darstellt wie es dort ist aber da bin ich gerade noch in der planung ;)
    Bilder

    • kalender.jpg

      32,22 kB, 768×480, 328 mal angesehen

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „bloodking“ ()

    Du kannst das mal als Rohskizze nehmen
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Private YearSheet As Worksheet
    2. Private Col As Integer, mmCol As Integer, kwCol As Integer
    3. Function CreateCalender(ByVal yyyy As Integer) As Worksheet
    4. Set YearSheet = CreateYearSheet(yyyy)
    5. InitYearSheet YearSheet
    6. Col = 1: mmCol = 1: kwCol = 1
    7. For d = Int(DateSerial(yyyy, 1, 1)) To Int(DateSerial(yyyy, 12, 31))
    8. Col = Col + 1
    9. dd = DateValue(d)
    10. SetMonth (dd)
    11. SetKW (dd)
    12. SetWd (dd)
    13. SetDay (dd)
    14. Next
    15. End Function
    16. Function CreateYearSheet(ByVal yyyy As Integer) As Worksheet
    17. wsName = Format(yyyy, "0000")
    18. On Error GoTo Create__Sheet
    19. Set CreateYearSheet = ThisWorkbook.Sheets(wsName)
    20. CreateYearSheet.Cells.Delete Shift:=xlUp
    21. Exit Function
    22. Create__Sheet:
    23. Set CreateYearSheet = ThisWorkbook.Sheets.Add
    24. CreateYearSheet.Name = wsName
    25. End Function
    26. Sub InitYearSheet(ByVal YearSheet As Worksheet)
    27. YearSheet.Range("A4") = "Mitarbeiter"
    28. YearSheet.Columns.ColumnWidth = 2
    29. YearSheet.Columns(1).ColumnWidth = 12
    30. YearSheet.Cells.Borders(xlEdgeLeft).LineStyle = xlNone
    31. YearSheet.Cells.Borders(xlEdgeRight).LineStyle = xlNone
    32. End Sub
    33. Sub SetMonth(ByVal dd As Date)
    34. MonName = Format(dd, "mmmm")
    35. isBegin = YearSheet.Cells(1, mmCol).Value <> MonName
    36. isEnd = isBegin And Col > 2
    37. EndCol = Col
    38. If DatePart("d", dd) = 31 And DatePart("m", dd) = 12 Then isEnd = True Else EndCol = EndCol - 1
    39. If isEnd Then
    40. Set MonthRange = YearSheet.Range(YearSheet.Cells(1, mmCol), YearSheet.Cells(1, EndCol))
    41. If MonthRange.Cells.Count > 1 Then MonthRange.Cells.Merge
    42. YearSheet.Columns(mmCol).Borders(xlEdgeLeft).Weight = xlThick
    43. YearSheet.Columns(EndCol).Borders(xlEdgeRight).Weight = xlThick
    44. MonthRange.Interior.Color = &H90C0FA
    45. MonthRange.Font.Bold = True
    46. MonthRange.HorizontalAlignment = xlCenter
    47. End If
    48. If isBegin Then
    49. YearSheet.Cells(1, Col).Formula = MonName
    50. mmCol = Col
    51. End If
    52. End Sub
    53. Sub SetKW(ByVal dd As Date)
    54. KwNr = "KW" & Format(DatePart("ww", dd, vbMonday, vbFirstFourDays), "00")
    55. isBegin = YearSheet.Cells(2, kwCol).Value <> KwNr
    56. isEnd = isBegin And Col > 2
    57. EndCol = Col
    58. If DatePart("d", dd) = 31 And DatePart("m", dd) = 12 Then isEnd = True Else EndCol = EndCol - 1
    59. If isEnd Then
    60. Set KwRange = YearSheet.Range(YearSheet.Cells(2, kwCol), YearSheet.Cells(2, EndCol))
    61. If KwRange.Cells.Count > 1 Then KwRange.Cells.Merge
    62. KwRange.Borders(xlEdgeLeft).Weight = xlThick
    63. KwRange.Borders(xlEdgeRight).Weight = xlThick
    64. KwRange.Borders(xlInsideVertical).LineStyle = xlNone
    65. KwRange.Interior.Color = &HE3B48D
    66. KwRange.Font.Bold = True
    67. KwRange.HorizontalAlignment = xlCenter
    68. End If
    69. If isBegin Then
    70. YearSheet.Cells(2, Col).Formula = KwNr
    71. kwCol = Col
    72. End If
    73. End Sub
    74. Sub SetWd(ByVal dd As Date)
    75. Dim Color As Long
    76. WD = Weekday(dd, vbMonday)
    77. YearSheet.Cells(3, Col).Formula = Mid("MDMDFSS", WD, 1)
    78. Color = &HFFFFFF
    79. If WD = 6 Then Color = &HD8D8D8
    80. If WD = 7 Then Color = &HBFBFBF
    81. 'If isHoliday(dd) Then Color = &HBFBFBF 'check for holidays
    82. YearSheet.Cells(3, Col).Interior.Color = Color
    83. YearSheet.Cells(4, Col).Interior.Color = Color
    84. End Sub
    85. Sub SetDay(ByVal dd As Date)
    86. YearSheet.Cells(4, Col).Formula = Day(dd)
    87. End Sub
    88. Sub DoIt()
    89. CreateCalender 2011
    90. End Sub
    Sauber formatieren und Feiertagsabfrage und sonstige Feinheiten musst du selbst machen.
    Und tu mir den Gefallen und versuch die Abläufe wenigstens zu verstehen, indem du's einmal mit dem Debugger durchsteppst.
    Mehr Hilfe gibt's nur bei detaillierten Fragen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    vielen dank ;) und ich nehm deine Worte zu herzen ;) Ich bin einfach nicht so der Skripter ;) Schule nie besser als 3 in Programmieren gehabt und dann habe ich irgendwie immmer das talent gehabt, leuten zu erklären wie sie es ermöglichen können ihre programme zu schreiben aber ich hatte dann immer nen hänger

    Gib mal im Direktfenster

    Quellcode

    1. ?Mid("1234",2,2)
    ein.
    Wenn da auch ein Fehler kommt, kann er das Mid nicht auflösen, weil irgendeine Referenz fehlt.
    Ansonsten sehe ich keinen Grund, weshalb das nicht funktionieren sollte, wenn du den restlichen Code so übernommen hast.

    Es sei denn: Du verwendest Excel 2003.
    Da kannst du nur 255 Spalten adressieren.
    Der Code ist für 2007 oder höher geschrieben, wo du diese Einschränkung nicht hast.

    Bei Excel 2003 musst du das entweder in zwei Sheets splitten oder ein Sheet in zwei Teile teilen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

Facebook
Telefonspende