AW: Feiertage mit VBA hervorheben
12.11.2006 20:04:55
fcs
Hallo Nils,
das mit der Zelle E51 war ein kleienr Programmierfehler meinerseits. Ist nun bereinigt.
Blattschutz wird Makro jetzt auch verarbeitet. Ist das Blatt geschützt, dann deaktivert das Makro ihn vorübergehend und schaltet ihn nach der bearbeitung wieder ein.
Laufindex:
Der Laufindex 1 bis 12 muß bleiben, er wird benötigt, um aus dem Feiertagsdatum den zugehörigen Blattnamen zu bestimmen.
Ich hab eine zusätzliche Schleife für die Schichten eingebaut. Falls es auch noch eine Nachtschicht geben sollte, dann muss du im Makro in der 4. Zeile das Array erweitern um einen Eintrag für die 2 Zeichen, die vor der Monatszahl stehen.
Gruss
Franz
Sub Feiertagemarkieren()
Dim wksDaten As Worksheet, wksMonat As Worksheet, Feiertag As Variant, Zelle As Range
Dim Zeile As Long, Monat As Integer, Bereich As Range
Dim Schichten, i As Integer, Schutz As Boolean
Schichten = Array("A-", "Z-")
Set wksDaten = Worksheets("Daten")
Zeile = 14 '1. Zeile mit Feiertag in Spalte G Blatt Daten
'vorhandene (alte) Feiertagseinträge löschen
For Monat = 1 To 12
For i = 0 To UBound(Schichten)
Set wksMonat = Worksheets(Schichten(i) & Format(Monat, "00"))
If wksMonat.ProtectContents = True Then
wksMonat.Unprotect
Schutz = True
Else
Schutz = False
End If
Set Bereich = Application.Union(wksMonat.Range("C20:G32"), wksMonat.Range("C67:G79"))
For Each Zelle In Bereich
If Zelle.Value = "Feiertag" Then
Zelle.ClearContents
Zelle.VerticalAlignment = xlVAlignCenter
Zelle.Font.Size = 18
Zelle.Offset(-2, 0).Range("A1:A2").Interior.ColorIndex = xlNone 'keine Farbe
End If
Next
If Schutz = True Then wksMonat.Protect
Next i
Next
'Feiertage markieren
Do
Feiertag = wksDaten.Cells(Zeile, "G")
If Feiertag = 0 Then Exit Do
For i = 0 To UBound(Schichten)
Set wksMonat = Worksheets(Schichten(i) & Format(Month(Feiertag), "00"))
If wksMonat.ProtectContents = True Then
wksMonat.Unprotect
Schutz = True
Else
Schutz = False
End If
Set Bereich = Application.Union(wksMonat.Range("C19:G31"), wksMonat.Range("C66:G78"))
For Each Zelle In Bereich
If Zelle.Value = Feiertag Then
Zelle.Offset(1, 0).Value = "Feiertag"
Zelle.Offset(1, 0).Font.Size = 10
Zelle.Offset(1, 0).VerticalAlignment = xlVAlignTop
Zelle.Offset(-1, 0).Range("A1:A2").Interior.ColorIndex = 15 'Hellgrau
End If
Next
If Schutz = True Then wksMonat.Protect
Next i
Zeile = Zeile + 2
Loop
End Sub
