Microsoft Excel

Herbers Excel/VBA-Archiv

Monatskalender | Herbers Excel-Forum


Betrifft: Monatskalender von: Uwe Siebers
Geschrieben am: 14.12.2009 09:58:16

Guten Morgen zusammen,

einmal mehr eine sicher kleinere Hürde, die ich zur Zeit nicht zu "nehmen" vermag. Nun denn. Für ein Tabellenblatt ("Zeitdaten") einer Arbeitsmappe habe ich ein, für meine Erwartungen, schlicht funktionierendes Modul, das ich über Worksheet_change anspreche:

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
Dim rng As Range

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)
    End If
        Anz_Tage = Day(DateSerial(Year(Datum), Month(Datum) + 1, 0))
        For Each wks In ThisWorkbook.Worksheets
            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

        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
Next wks

ERRHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("Zeitdaten").Select
End Sub
Nun denn... Jetzt ist es so, das ich dieses Modul ergänzen muß. Für das Arbeitsblatt "31100000" (dieses kommt in insgesamt 22 Arbeitsmappen unverändert vor) ist die Prozedur perfekt. Nicht aber für die weiteren Arbeitsblätter (zwischen 23 und 44) dieser Arbeitsmappen. Hier sind z.B. Zellen A5:B35 anzusprechen. Lange Rede, kurzer Sinn...

Wie bekomme ich`s hin, das eine Prozedur (kleinere Änderungen müßte ich im o.g. Code dazu dann vornehmen) zwar für alle anderen Blätter (zwischen 23 und 44) nicht aber für das Blatt "Zeitdaten" (31100000) (Hierfür soll die o.g. Prozedur gelten) gilt?

Na, meine Vermutung ist ja zur Zeit die, das die Anweisung "For Each wks In ThisWorkbook.Worksheets" noch irgendwie falsch steht.

Zudem habe ich in den zur Zeit 22 Arbeitsmappen die einzelnen Blätter immer nach System benannt. Das Blatt "Zeitdaten" ist z.B. hierbei stets 31100000, alle weiteren Blätter z.B. 31100010 bis 31100230. So ich diese Bezeichnungen in Codes ansprechen kann, wäre mir seeehr geholfen, da eben diese Bezeichnungen in allen 22 Arbeitsmappen identisch sind. Nur wie das...???

Besten Dank für Eure (Nach)Hilfe.

Uwe

  

Betrifft: AW: Monatskalender von: Uduuh
Geschrieben am: 14.12.2009 10:48:14

Hallo,
evtl so:

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
Dim rng As Range
Dim iOffset 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)
  End If
  Anz_Tage = Day(DateSerial(Year(Datum), Month(Datum) + 1, 0))
  For Each wks In ThisWorkbook.Worksheets
      Select Case wks.CodeName
        Case "tb31100000"
          iOffset = 6
        Case Else
          iOffset = 5
        End Select
        With wks
          .Range(.Cells(iOffset, 1), .Cells(iOffset + 30, 3)).ClearContents
          For Anz_Eintrag = 0 To Anz_Tage - 1
            .Cells(Anz_Eintrag + iOffset, 2).Value = Datum + Anz_Eintrag
            .Cells(Anz_Eintrag + iOffset, 3).Value = Format(Datum + Anz_Eintrag, "ddd")
            If Weekday(.Cells(Anz_Eintrag + iOffset, 3), vbMonday) > 5 Then
              .Cells(Anz_Eintrag + iOffset, 2).Resize(, 26).Interior.ColorIndex = 40
            Else
              .Cells(Anz_Eintrag + iOffset, 2).Resize(, 26).Interior.ColorIndex = xlNone
            End If
          Next Anz_Eintrag
        End With
  Next wks

ERRHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("Zeitdaten").Select
End Sub

Gruß aus’m Pott
Udo



  

Betrifft: AW: Monatskalender von: Uwe Siebers
Geschrieben am: 14.12.2009 11:07:21

Sorry, Udo!

Deine Veränderung des Moduls bringt mich leider nicht weiter. Ausschließlich der erste Tag des Monats wird im Blatt "Zeitdaten" eingetragen. Mehr "geschieht" nicht...

Mir geht es vorrangig halt darum, das für das Tabellenblatt "Zeitdaten" der Code durchläuft, ich aber die Möglichkeit bekomme, diesen Code für alle anderen Tabellenblätter etwas zu verändern (es ändern sich die Zellen in denen die Kalendertage eingetragen werden sollen, die farbliche Markierung der Wochenenden entfällt hingegen)

Tja...

Uwe


  

Betrifft: AW: Monatskalender von: Uduuh
Geschrieben am: 14.12.2009 11:55:34

Hallo,
dann steigt der Code irgendwo aus.
Geh ihn mal schrittweise (F8) durch.

Gruß aus’m Pott
Udo



  

Betrifft: AW: Monatskalender von: Uwe Siebers
Geschrieben am: 14.12.2009 12:29:10

Hey Udo,

tatsächlich "steigt" der Code bei

If Weekday(.Cells(Anz_Eintrag + iOffset, 3), vbMonday) 5 Then

aus. Und nu?

Gruß

Uwe


  

Betrifft: AW: Monatskalender von: Michael
Geschrieben am: 14.12.2009 13:26:53

Hallo,



fehlt dort eventuell das "größer" Zeichen vor der 5?



Grüße



Michael


  

Betrifft: AW: Monatskalender von: Uwe Siebers
Geschrieben am: 14.12.2009 13:40:15

Hallo Michael,

nööö, das ist mir wohl beim Einfügen des Codes "abhanden gekommen".

Gruß

Uwe