Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Ergänzung eines Moduls | Herbers Excel-Forum


Betrifft: Ergänzung eines Moduls von: Uwe Siebers
Geschrieben am: 16.12.2009 10:42:15

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

  

Betrifft: AW: Ergänzung eines Moduls von: Reinhard
Geschrieben am: 16.12.2009 12:05:54

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


  

Betrifft: AW: Ergänzung eines Moduls von: Uwe Siebers
Geschrieben am: 16.12.2009 12:28:32

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


  

Betrifft: AW: Ergänzung eines Moduls von: Reinhard
Geschrieben am: 16.12.2009 12:31:04

Hallo Uwe,

ich meinte schon mit Stern

If Not wks Is tb31100010 And wks.Name Like "tb3110*" Then

Gruß
Reinhard


  

Betrifft: AW: Ergänzung eines Moduls von: Uwe Siebers
Geschrieben am: 16.12.2009 12:41:30

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.


  

Betrifft: AW: Ergänzung eines Moduls von: Reinhard
Geschrieben am: 16.12.2009 12:55:27

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


  

Betrifft: AW: Ergänzung eines Moduls von: Uwe Siebers
Geschrieben am: 16.12.2009 13:07:03

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