Farbe in Zellbereich richtig setzen
Heinz
Habe unteres Makro das mir ab A5:A34 das Datum von Mo.-Fr. ohne WE setzt.
Das funkt. auch.
Nur besagt das Makro auch, nach jeden Fr. oder Monatsletzten nächste Spalte mit .Interior.ColorIndex = 37
Das funkt. auch zu 90% nur kann es vorkommen Zb. A26 = 28. Feb.2010 nach Monatsletzten
A27= .Interior.ColorIndex = 37 (Ist richtig)
A28 kommt auch .Interior.ColorIndex = 37(Ist falsch) Hier sollte keine Farbe gesetzt werden.
Könnte mir bitte dazu jemand helfen ?
Gruß
Heinz
'Blattname neu bestimmen
ActiveSheet.Name = Range("G1")
ActiveSheet.Unprotect Password:="woody-6962"
Dim datStart As Date, datEnd As Date
Dim lDay As Long
Dim iRow As Integer, lngStart As Long, lngCol As Long
datStart = Range("F1").Value ' in der Zelle M3 befindet sich das Anfangsdatum
datEnd = Range("H1").Value ' in der Zelle H1 befindet sich das Enddatum
iRow = 6 'Hiermit wird gesagt, dass in Zeile 6 angefangen werden soll
lngStart = iRow
Range("A6:A35").EntireRow.ClearContents ' Statt löschen der Zeilen werden nur Inhalte gelö _
scht
Range("C6:F35").EntireRow.ClearContents ' Statt löschen der Zeilen werden nur Inhalte gelö _
scht
Range("L6:L35").EntireRow.ClearContents ' Statt löschen der Zeilen werden nur Inhalte gelö _
scht
Range("A6:A35").EntireRow.Interior.ColorIndex = xlColorIndexNone 'Entfernt Farbe aus _
Zellbereich
Range("A6:O35").Font.Bold = False 'Schriftart Fett zurücksetzen
Range("A6:A35").NumberFormatLocal = "TT.MM.JJJJ"
Range("B6:B35").NumberFormatLocal = "TTT"
Range("A6:O35").Locked = True 'Zellschutz aufheben
'Rahmen Zurücksetzung
Range("A7:O34").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
'Rahmen Neu setzen
If Weekday(datEnd) = 7 Then
datEnd = datEnd - 1
End If
For lDay = datStart To datEnd
Select Case Weekday(lDay, 2)
Case Is 0 Then MsgBox "Fehler: " & Err.Number & vbLf & _
Err.Description
ActiveSheet.Protect Password:="woody-6962"
Call Blattschutz
End Sub