Modul zu umständlich?
Uwe
Nachfolgendes Modul "läuft" eigentlich ganz zufriedenstellend, eigentlich:
Option Explicit
'Festsetzung der Kalendertage im Bearbeitungsmonat pro Tabellenblatt
Public Sub TageImMonat()
Dim Anz_Tage As Integer
Dim Anz_Eintrag As Integer
Dim Datum As Date
Dim wks As Worksheet, w As Worksheet
Dim i As Integer, run As Integer
On Error GoTo ERRHANDLER
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Sheets("Zeitdaten").Activate
If IsDate([A1]) Then
Datum = DateSerial(Year([A1]), Month([A1]), 1)
Else
'Bei fehlender Eingabe des Bearbeitungsmonats Ausgabe eines Warnhinweises
MsgBox "Bitte Abrechnungsmonat eintragen!", 16, " Hinweis für " & Application.UserName
Exit Sub
End If
Anz_Tage = Day(DateSerial(Year(Datum), Month(Datum) + 1, 0))
For Each wks In ThisWorkbook.Worksheets
'Bearbeitung des Tabellenblattes Zeitdaten
If wks Is tb31100000 Then
With wks
.Range("A6:C36").ClearContents
For Anz_Eintrag = 0 To Anz_Tage - 1
.Cells(Anz_Eintrag + 6, 2).Value = Datum + Anz_Eintrag
.Cells(Anz_Eintrag + 6, 3).Value = Format(Datum + Anz_Eintrag, "ddd")
Next Anz_Eintrag
End With
End If
'Zellen innerhalb der Wochenenden farblich hervorheben
Dim rng As Range
For Each rng In Range("C6:C36")
Select Case rng.Text
Case "Sa", "So"
rng.Offset(, -1).Resize(, 25).Interior.ColorIndex = 40
Case Else
rng.Offset(, -2).Resize(, 26).Interior.ColorIndex = xlNone
End Select
Next
'Bearbeitung des Tabellenblattes TVöD
If wks Is tb31100010 Then
With wks
.Range("A5:F35").ClearContents
.Range("A44:B74").ClearContents
'Übernahme der Kalenderdaten aus dem Blatt Zeitdaten
For Anz_Eintrag = 0 To Anz_Tage - 1
'Übernahme der Kalenderdaten im Erfassungsbereich
.Cells(Anz_Eintrag + 5, 1).Value = Datum + Anz_Eintrag
.Cells(Anz_Eintrag + 5, 2).Value = Format(Datum + Anz_Eintrag, "ddd")
'Übernahme der Kalenderdaten im Bereich der festgesetzten Zeitzuschläge
.Cells(Anz_Eintrag + 44, 1).Value = Datum + Anz_Eintrag
.Cells(Anz_Eintrag + 44, 2).Value = Format(Datum + Anz_Eintrag, "ddd")
Next Anz_Eintrag
'miteinander verbundene Zellen erst mal trennen
.Range("C5:C35").UnMerge
.Range("AA5:AB35").UnMerge
'damit diese gemäß den Kalenderwochen des Bearbeitungsmonats miteinander verbunden werden kö _
nnen
'zur Sicherheit zunächst erst Einträge löschen
.Range("C5:C35").ClearContents
For i = 5 To 35
If DINKW(.Cells(i, 1)) = DINKW(.Cells(i - 1, 1)) And .Cells(i, 1) > 0 Then
With .Range(.Cells(i - 1, 3), .Cells(i, 3))
.Merge
With .Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
'Zellen der Spalte AA wie Spalte C nach Kalenderwochen miteinander verbinden
With .Range(.Cells(i - 1, 27), .Cells(i, 27))
.Merge
With .Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
'Zellen der Spalte AB wie Spalte C nach Kalenderwochen miteinander verbinden
With .Range(.Cells(i - 1, 28), .Cells(i, 28))
.Merge
With .Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If
Next i
End With
'Festsetzung der wöchentlichen Sollstunden
Call Soll_TVöD(wks, 5, 35)
End If
Next wks
Call Worksheets("Mitarbeiter1").Arbeitszeit_TVöD
'Was geschieht, wenn irgendwas falsch läuft? Die Fehlerroutine...
ERRHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("Zeitdaten").Select
End Sub
1.) Die Anweisung If wks Is tb31100010 Then... soll nicht nur für dieses Tabellenblatt, sondern für insgesamt 23 gleiche Blätter (tb31100010 bis 31100230) gelten. Nicht aber eben für das Blatt 31100000.
Es macht sicher keinen Sinn, die genannte Anweisung derart oft zu wiederholen. Wie aber schreibe ich diese Anweisung so, das sie für alle Blätter, nicht aber für eben das tb31100000 gilt?
2.) Die Anweisung Call Worksheets("Mitarbeiter1").Arbeitszeit_TVöD hingegen möchte ich zwar so gestalten, das ich diese für jedes Tabellenblatt (hier ist ein privates Modul zu durchlaufen) aufführe. Dies soll aber anhand der vergebenen Nummer (wie unter 1.)) nicht aber anhand des Namens gesehen. Die Namen der Mitarbeiter sinsd (logo) unterschiedlich; hingegen unterliegen die Blattnummern stets einer bestimmten Struktur. Wie schreibe ich das?
Für Hilfe, sachdienliche Hinweise bin ich natürlich wieder dankbar.
Gruß
Uwe