Makro erweitern
23.02.2005 08:10:10
Hans
hätte da eine Frage zu zwei Makros: (ich weiss, das ich die Fragen schon mal gestellt habe aber leider ohne Erfolg)
Erstens: mit folgendem Code erstelle ich in einem definiertem Bereich einen Kalender. Kann man den Code so erweitern, dass er mir die Schriftfarbe der Sonntage plus die nebenstehenden 12 Zellen auf rot stellt ?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "L1" Then Exit Sub
Application.ScreenUpdating = False
EnableEvents = False
For n = 1 To 12
sp = (n - 1) * 17
Range(Cells(18, sp + 3), Cells(48, sp + 4)).ClearContents
Range(Cells(18, sp + 3), Cells(48, sp + 4)) = DateSerial([L1], n, 1)
letzte = 30
While Month(Cells(18, sp + 3) + letzte) <> Month(Cells(18, sp + 3))
letzte = letzte - 1
Wend
'Range(Cells(18, sp + 3), Cells(18, sp + 4)).AutoFill Destination:=Range(Cells(18, sp + 3), Cells(18 + letzte, sp + 4)), Type:=xlFillDefault
Range(Cells(18, sp + 3), Cells(18 + letzte, sp + 4)).DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
xlDay, Step:=1, Trend:=False
Next n
Call Kommentar
Call Kommentar1
EnableEvents = True
Application.ScreenUpdating = True
End Sub
Zweitens: Mit folgendem Code lass ich die Feiertage als Kommentar eintragen, auch hier die Frage nach der Schriftfarbe. Kann man das so umbauen, dass die 2 links stehenden und die 11 rechts stehende zellen auf rote Schrift umstellt ?
Sub Kommentar()
On Error Resume Next 'gibt Fehler wenn kein Kommentar vorhanden
With Worksheets("Fs Eintrag")
Set Bereich = Application.Union(.Range("d18:e48"), .Range("u18:v48"), .Range("al18:am48"), _
.Range("bc18:bd48"), .Range("bt18:bu48"), .Range("ck18:cl48"), .Range("db18:dc48"), .Range("ds18:dt48"), .Range("ej18:ek48"), _
.Range("fa18:fb48"), .Range("fq18:fs48"), .Range("gh18:gj48"))
Bereich.SpecialCells(xlCellTypeComments).ClearComments
For n = 148 To 160
z = 17 + Day(Worksheets("Fs Eintrag").Cells(n, 1))
s = (Month(Worksheets("Fs Eintrag").Cells(n, 1)) - 1) * 17 + 5
.Cells(z, s).AddComment
.Cells(z, s).Comment.Visible = False
.Cells(z, s).Comment.Text Text:=Worksheets("Fs Eintrag").Cells(n, 2).Value
Next n
End With
End Sub
Ich würde es ja mit bedingter Formatierung tun, die nutz ich aber schon anders.
Bin über jede hilfe Dankbar.
Bis später hoffentlich
Gruss Hans