Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1124to1128
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ergänzung eines Moduls

Ergänzung eines Moduls
Uwe
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...

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Ergänzung eines Moduls
16.12.2009 12:05:54
Reinhard
Hallo Uwe,
benutze demnächst Einrückungen.
Option Explicit
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 Not wks Is tb31100010 And wks.Name Like "tb3110*" 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

Gruß
Reinhard
Anzeige
AW: Ergänzung eines Moduls
16.12.2009 12:28:32
Uwe
Hallo Reinhard,
leider funktioniert`s nur für das Tabellenblatt "tb31100010" wie gewünscht. Bei allen anderen "tut" sich leider nichts. Eine Fèhlermeldung gibt`s hingegen aber schon mal nicht. Ich gehe im Augenblick davon aus, das die Anweisung:
If Not wks Is "tb31100010" And wks.Name Like "tb31100080" Then
noch nicht richtig ist...
Bist Du so gut und sieh`st den Code noch mal durch?
Besten Dank für Deine Mühe.
Gruß
Uwe
PS: Irgendwann lern ich`s auch noch mit dem Einrücken... Sorry!!!
AW: Ergänzung eines Moduls
16.12.2009 12:31:04
Reinhard
Hallo Uwe,
ich meinte schon mit Stern
If Not wks Is tb31100010 And wks.Name Like "tb3110*" Then
Gruß
Reinhard
Anzeige
AW: Ergänzung eines Moduls
16.12.2009 12:41:30
Uwe
Hallo Reinhard,
das hätte ich natürlich schreiben sollen... Das eben auch "das mit dem *" nicht funktioniert. Es tut sich schlicht nix. Nach wie vor keine Fehlermeldung.
Prüfe ich via F8 allerdings das Modul "steigt" Excel in JEDER Zeile vor Deiner Änderung aus.
Und jetzt?
Gruß
Uwe
PS: Bist zu gut und erklärst mir die Bedeutung des Sterns? Denn eigentlich sollen die Tabellenblätter schon benannt werden, für die diese Anweisung
If wks Is "tb31100010" Then
eben nicht gelten soll.
AW: Ergänzung eines Moduls
16.12.2009 12:55:27
Reinhard
Hallo Uwe,
schreib mal ganz zuoberst
Option Explicit
in das Modul. Dann nochmal F8...
Der Stern ist das Jokerzeichen für "like", siehe Hilfe dazu.
Gruß
Reinhard
Anzeige
AW: Ergänzung eines Moduls
16.12.2009 13:07:03
Uwe
Tja,
Option Explicit stand bereits da. Ich denke, wir sollten noch mal vom ursprünglichen, funktionierenden Modul ausgehen? Dann in zwei Schritten ausbauen...
1.) Nicht nur das Blatt "tb31100010" sondern "tb31100010" bis "tb31100230" ansprechen
dann erst
2.) Das Blatt "tb31100080" später ausklammern und mit etwas verändeter Anweisung durchlaufen
Wäre das `ne Idee für Dich?
Mmmhhh, wäre schon suuuper, wenn`s klappt. Denn, ein zwei Kurven noch und ich bin auf der Zielgeraden bei meinem Projekt. Aber hier stecke ich schlicht fest...

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige