Hallo bt,
uff, wo fange ich an…
Was das Einfärben angeht, ist es eigentlich kein Problem, Du musst nur das EVENT ‚Worksheet_Change‘ benutzen, das jede Zelle dieser Tabelle überwacht… und das könnte dann so aussehen :
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim varNeu As Variant
Dim varAlt As Variant
Dim x As Integer
Dim y As Integer
Dim a As Variant
Dim b As Integer
' wenn mehr als eine Zelle geändert wurde wird
' diese Funktion übergangen
If Target.Count \> 1 Then
Exit Sub
End If
' welche Zelle wurde nach dem Verlassen angesprungen
x = ActiveCell.Row
y = ActiveCell.Column
' Events stoppen, da diese Function sich sonst
' selber auslöst (Rekursion)
Application.EnableEvents = False
' was steht jetzt in der Zelle (neuer Eintrag)
' Einträge, die kürzer als 4 Buchstaben sind,
' werden dabei in Großbuchstaben gewandelt
' (Unterscheidung von Namen und Diensten)
If Len(Target.Value) varAlt Then
' Wie lautet der neue Eintrag
' Ich hab mich hier für die Farbangabe in RGB entschieden
' da diese leicht zu GOOGELn sind \*G\*
' Die Werte stehen für Farbanteile
' R = ROT, G = Grün , B = BLAU
' Mit diesem CASE lassen sich also
' 256 \* 256 \* 256 = 16.581.375
' bedingte Formatierungen erzeugen...
' Wenn man jetzt noch Schriftart, -größe, Rahmen...
' mit einbezieht, kommt man auf eine nahezu unbegrenzte
' Anzahl
Select Case varNeu
Case Is = "U"
a = RGB(255, 0, 0) ' ROT
b = 1
Case Is = "N"
a = RGB(0, 255, 0) ' GRÜN
b = 1
Case Is = "K"
a = RGB(0, 0, 255) ' BLAU
b = 1
Case Is = "KK"
a = RGB(0, 150, 255) ' hell BLAU
b = 1
Case Else
b = 0
End Select
' die mit a festgelegt Farbe als Pattern eintragen oder aufheben
If b = 1 Then
With Selection.Interior
.Pattern = xlSolid
.Color = a
End With
Else
Selection.Interior.ColorIndex = xlNone
End If
End If
' Durch das UNDO wurde die alte Zelle wieder selectiert, darum
' muss die Zelle, die nach der Änderung
' angesprungen wurde, erneut angesprungen werden
Cells(x, y).Select
' Jetzt können die Events wieder aktiviert werden,
' da jetzt keine Änderungen mehr zu einem weiteren
' Aufruf dieser Funktion führen
Application.EnableEvents = True
End Sub
Was den Kalender angeht… da gibt es schon eher Probleme, denn Feiertage sind nicht gleich Feiertage und einige sind auch noch beweglich… aber fangen wir mal klein an.
Annahme :
- In Zelle A1 steht der 1.1. des gewünschten Jahres
- In Spalte A kommen die Wochentage
- In Spalte B das Kurzdatum (ohne Jahr)
- In Zeile 2 ab Spalte C stehen die Namen der Mitarbeiter
Formatiere Zelle A1 in jjjj (Benutzerdefiniert) und trage den ‚1.1.2011‘ ein, dann sollte da ‚2011‘ stehen.
Markiere Zelle A3 und formatiere diese in TTT (Benutzerdefiniert)
Trag in Zelle A3 ‚=A1‘ ein, dann steht da ‚Sa‘
Markiere Zelle B3 und formatiere diese in TT.MM. (Benutzerdefiniert)
Trag in Zelle B3 jetzt ‚=A3‘, dann steht da jetzt ‚01.01.‘
Jetzt markiere die Zellen A3:B3 und wähle ‚Bedingte Formatierung‘ und wähle dort aus ‚Formel ist‘. Als Bedingung schreibst Du dann ‚=WOCHENTAG(A3)=1‘ und wählst eine Formatierung (wobei 1=Sa, 0=So).
mit Hinzufügen kannst Du an dieser Stelle gleich noch eine Formatierung für ‚So‘ festlegen.
Jetzt sollte die Zellen A3:B3 Dein Sa-Format anzeigen.
Jetzt markierst Du Die Zellen A3:B3 und kopierst diese in die nächste Zeile und schreibst dann in Zelle A4 ‚=A3+1‘
Die Zellen A4:B4 jetzt so ca 364 mal nach unten kopieren ^^ oder nach unten ausfüllen.
Wann immer Du jetzt in Zelle A1 Das Datum änderst, wird die Tabelle neu berechnet.
Was einen einfachen Kalender angeht, hast Du hier also einen kleinen Ansatz.Wenn Du die FT auch automatisch berechnen willst, musst Du den fertigen Kalender nach Den Datumswerten durchsuchen lassen und dann einfärben… Dafür sollte man eine Funktion benutzen, die alle festen FT kennt und alle beweglichen FT nach Gauss berechnet … und dann in der Tabelle diese Zeilen suchen und markieren (wobei eine bedingte Formatierung gewinnt)… machbar aber irgendwie auch läßtig.
Wenn Du da wirklich ran willst, sag bescheid und richte Dich auf einen Knoten im Hirn ein ^^ und sag bitte auch bescheid, ob das hier bei Dir funktioniert, damit ich es dann abschließen kann.
So, viel Spass beim Testen,
_ Burkhard _
Kurzform :
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim varNeu As Variant
Dim varAlt As Variant
Dim x As Integer
Dim y As Integer
Dim a As Variant
Dim b As Integer
If Target.Count \> 1 Then
Exit Sub
End If
x = ActiveCell.Row
y = ActiveCell.Column
Application.EnableEvents = False
If Len(Target.Value) varAlt Then
Select Case varNeu
Case Is = "U"
a = RGB(255, 0, 0) ' ROT
b = 1
Case Is = "N"
a = RGB(0, 255, 0) ' GRÜN
b = 1
Case Is = "K"
a = RGB(0, 0, 255) ' BLAU
b = 1
Case Is = "KK"
a = RGB(0, 150, 255) ' hell BLAU
b = 1
Case Else
b = 0
End Select
If b = 1 Then
With Selection.Interior
.Pattern = xlSolid
.Color = a
End With
Else
Selection.Interior.ColorIndex = xlNone
End If
End If
Cells(x, y).Select
Application.EnableEvents = True
End Sub