Hej PI,
Jeg styrer rigtig nok ikke formateringen med betinget formatering, da det kræver flere kriterier end den (I Excel 2003 og tidligere) kan håndtere.
Jeg gør det via en såkaldt event, som aktiveres når en celle inden for et defineret områder ændres.
Koden ser således ud og placeres under det ark som skal indeholde funktionen:
' Developed by Allan Thustrup Mortensen - Excel-regneark.dk
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo Endmacro
If Application.Intersect(Target, Range("e17:bn36")) Is Nothing Then
Exit Sub
End If
If Target.Cells.Count > 1 Then
Target.Interior.ColorIndex = StandardFarve
Target.Font.ColorIndex = 1
Target.Font.Bold = False
Exit Sub
End If
If Target.Value = "" Then
Target.Interior.ColorIndex = 0
Exit Sub
End If
'Syg
If Target.Value = "s" Or Target.Value = "S" Then
Target.Interior.ColorIndex = 38
Target.Offset(0, 1).Activate
Exit Sub
End If
'Ferie, FerieFridag
If Target.Value = "f" Or Target.Value = "F" Or Target.Value = "ff" Or Target.Value = "FF" Then
Target.Interior.ColorIndex = 37
Target.Offset(0, 1).Activate
Exit Sub
End If
'Barn syg
If Target.Value = "bs" Or Target.Value = "BS" Then
Target.Interior.ColorIndex = 38
Target.Offset(0, 1).Activate
Exit Sub
End If
'Betalt fri
If Target.Value = "bf" Or Target.Value = "BF" Then
Target.Interior.ColorIndex = 35
Target.Offset(0, 1).Activate
Exit Sub
End If
'Kursus
If Target.Value = "k" Or Target.Value = "K" Then
Target.Interior.ColorIndex = 27
Target.Offset(0, 1).Activate
Exit Sub
End If
'Orlov
If Target.Value = "o" Or Target.Value = "O" Then
Target.Interior.ColorIndex = 37
Target.Offset(0, 1).Activate
Exit Sub
End If
Kol = Target.Column
'hvis du befinder dig i sluttidsfeltet, skal vi bruge datoen for starttidsfeltet
If Ark1.Cells(2, Target.Column) = "" Then Kol = Target.Column - 1
'hvis det er en hverdag, så skal standard farven være gul
If Weekday(Ark1.Cells(2, Kol), vbMonday) < 6 Then StandardFarve = 36
'hvis det er en hverdag, så skal standard farven være laksefarvet
If Weekday(Ark1.Cells(2, Kol), vbMonday) > 5 Then StandardFarve = 40
Exit Sub
Endmacro:
MsgBox " Indtastningsfejl !!!" & Chr(13) & Chr(13) & " Se evt. arket 'Forklaring' " & Chr(13) & Chr(13) & " Prøv igen !"
Application.EnableEvents = True
End Sub
Jeg skal måske lige nævne at denne minivagtplan er en pixiudgave af et større vagtplanssystem som kan styre vagtlægning af op til 150 personer med time/lønskema, fraværsstatistik og prognostisering frem i tiden.
I den 'rigtige' vagtplan kan man vagtplanlægge ud fra de ansattes kompetencer og den kan faktisk lægge en optimal vagtplan automatisk samtidig med den tager højde for ønsker, ferie og andet.
//Allan