cellen kleuren via formulle

[davylenders007]

Heb een exel kalender gevonden op de site die alles heeft wat ik zoek behalve 1 ding.

Ik zou nog graag willen dat ik in cellen een bepaalde letter ingeef de cel een bepaald kleur krijgt.

Het gaat over de cellen waar de datum instaat.
Het gaat eigenlijk over een kalender om het verlof bij te houden van een 50 man.
Heb hieronder de gegevens gekopierd die in visual basic zijn ingegeven.
zou nu willen als ik in een cel bv een v invul (afkorting voor verlof) dat de cel een kleur krijgt.
Ik weet dat het ook mogelijk is met voorwaardelijk opmaak maar in exel 2003 kan je er maar 3 aanmaken en dat is te weining
daarom zou ik het graag oplossen door een formulle toe te voegen maar weet niet de welke.
Kan mij iemand helpen.



'-------------------------------------------------------------------
' Universeel planbord
' (c) H.M. Pragt 2006
'-------------------------------------------------------------------

Private Sub CommandButton1_Click()
  Call CreateCalendar
End Sub

Sub CreateCalendar()
Dim lMaand As Long
Dim lDagen As Long
Dim lInd As Long
Dim dDate As Date
Dim DagLetters(1 To 7) As String
Dim Maanden(1 To 12) As String
Dim NaamKalender As String
Dim AantalMed As Long
Dim Color1 As Long
Dim Color2 As Long
Dim Jaar As Long

    DagLetters(1) = "Zo"
    DagLetters(2) = "Ma"
    DagLetters(3) = "Di"
    DagLetters(4) = "Wo"
    DagLetters(5) = "Do"
    DagLetters(6) = "Vr"
    DagLetters(7) = "Za"
    Maanden(1) = "Jan"
    Maanden(2) = "Feb"
    Maanden(3) = "Mrt"
    Maanden(4) = "Apr"
    Maanden(5) = "Mei"
    Maanden(6) = "Jun"
    Maanden(7) = "Jul"
    Maanden(8) = "Aug"
    Maanden(9) = "Sep"
    Maanden(10) = "Okt"
    Maanden(11) = "Nov"
    Maanden(12) = "Dec"
       
    Jaar = Val(Worksheets("Parameters 1").Range("B1").Value)
    NaamKalender = Worksheets("Parameters 1").Range("B2").Value
    AantalMed = Val(Worksheets("Parameters 1").Range("B3").Value)
       
    If (AantalMed < 1) Then
      MsgBox "Aantal namen moet groter zijn dan 0!"
      Exit Sub
    End If
    
    Worksheets("avond + bediende").Cells.ClearContents
    Worksheets("avond + bediende").Cells.ClearFormats
       
    Color1 = RGB(220, 220, 220)
    Color2 = RGB(255, 136, 55)
    Color3 = vbWhite
       
     'Pass ranges for months
     For lMaand = 0 To 11
       Set CurCel = Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 1, 1)
       CurCel.Value = Maanden(lMaand + 1)
       CurCel.Font.Bold = True
       CurCel.ColumnWidth = 10#
       CurCel.HorizontalAlignment = xlLeft
       Set CurCel = Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 2, 1)
       CurCel.Value = Jaar
       CurCel.Font.Bold = True
       CurCel.HorizontalAlignment = xlLeft
       Set CurCel = Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 1, 2)
       CurCel.Value = NaamKalender
       CurCel.Font.Bold = True
       For lDagen = 1 To 32
         Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 1, lDagen).Interior.Color = Color1
         Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 2, lDagen).Interior.Color = Color2
       Next lDagen
       Worksheets("avond + bediende").Range(Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 2, 1), Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 2, 32)).BorderAround ColorIndex:=0, Weight:=xlMedium
       Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 2, 1).Interior.Color = Color2
       For lDagen = 1 To 31
        'Add dates to month range and format
        dDate = DateSerial(Jaar, (lMaand + 1), lDagen)
        Set CurCel = Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 3, lDagen + 1)
        If Month(dDate) = (lMaand + 1) Then ' It's a valid date
          If Weekday(dDate) = 7 Then
            CurCel.Interior.Color = Color1
          Else
            CurCel.Interior.Color = Color2
          End If
          If (Weekday(dDate) = 2) Then
            Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 2, lDagen + 1).Value = "Week " & DatePart("ww", dDate, vbMonday, vbFirstFourDays)
            Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 2, lDagen + 1).HorizontalAlignment = xlCenter
          End If
          CurCel.Value = DagLetters(Weekday(dDate))
          CurCel.HorizontalAlignment = xlCenter
          For lInd = 0 To (AantalMed - 1)
            Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + lInd + 4, 1).Value = _
            Worksheets("Parameters 1").Cells(4 + lInd, 2).Value
            Set CurCel = Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + lInd + 4, lDagen + 1)
            If (Weekday(dDate) = 7) Then
              CurCel.Interior.Color = Color1
            Else
              CurCel.Interior.Color = Color3
            End If
            CurCel.Value = lDagen
            CurCel.NumberFormat = "##"
            CurCel.ColumnWidth = 3#
            CurCel.Font.Size = 8
            CurCel.HorizontalAlignment = xlCenter
            CurCel.BorderAround LineStyle:=xlContinuous
          Next lInd
        Else
          For lInd = 0 To AantalMed
            Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + lInd + 3, lDagen + 1).Interior.Color = Color1
          Next lInd
        End If
      Next lDagen
      Worksheets("avond + bediende").Range(Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + 1, 1), Worksheets("avond + bediende").Cells(lMaand * (AantalMed + 5) + AantalMed + 3, 32)).BorderAround ColorIndex:=0, Weight:=xlThick
    Next lMaand
        
End Sub

 

[huijb]

verplaatst.