Guten Morgen zusammen,
gerade eben hab ich festgestellt, das ich die Ergänzung/Erweiterung eines eigentlich funktionierenden Moduls einfach nicht hinbekomme:
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("Mitarbeitername").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
Wie ersichtilch ist, durchläuft dieses Modul die beiden Tabellenblätter tb31100000 bzw. tb31100010 mit recht unterschiedlichen Anweisungen. So weit ist das o.k.
Wäre da nicht (m)ein Problem:
Die Anweisung für "tb31100000" soll unverändert bleiben, hingegen die für "tb31100010" nicht nur für dieses Tabellenblatt sondern für eine Vielzahl an Blättern gelten. Hierbei sind die "restlichen" Blätter stets nach gleichem System (z.B. "tb31100010", "tb31100020" bis "tb31100220" usw.) benannt.
Bin mir eigentlich sicher, das dieses Problem lösbar ist. Aber zur Zeit für mich? Puuuh...
Bin Euch für Hiiilfeee natürlich sehr dankbar.
Besten Dank
Uwe
PS: Die derzeitige Anweisung zum Blatt "tb31100010" gilt leider nicht für alle restlichen Blätter der Arbeitsmappe. Es gibt da bis zu drei Ausnahmen (z.B. "tb31100230" o.ä.) Das macht`s sicher nicht einfacher... Hier ändert sich die "Prozedur" geringfügig. Tja...