PDA

Vollständige Version anzeigen : Mit Kalenderfunktion keine bedingte Formatierung


Besucher XYZ
27.03.2012, 07:12
Guten Morgen

In einer Tabelle habe ich diverse CB die ein Kalender aktivieren womit ich dann das gewünschte Datum in eine bestimmte Zelle einfügen kann. Diese bestimmten Zellen habe ich bedingt formatiert mit =AC24=HEUTE() so dass das Datum rot wird. Das Problem ist, wenn ich es mit der Kalenderfunktion mache bleibt das Datum schwarz. Wenn ich aber das Datum von Hand einfüge wechselt es in Rot. Die Zellen habe ich mit Datum formatiert. (14.03.2001) Woran könnte das liegen. Besten Dank für Eure Hilfe. (MS Office 2010)
Hier der Code vom Kalender

Modul:

Option Explicit

Public cLabel() As New clsLabel
Public aktDat As Date
Public bool As Boolean

Function ErsterKW(KW As Integer, Jhr As Integer) As Double
Dim Erstertag As Double
If Month(aktDat) = 1 And KW > 51 Then Jhr = Jhr - 1
Erstertag = DateSerial(Jhr, 1, 1)
Do Until DatePart("WW", Erstertag, 2, 2) = 2
Erstertag = Erstertag + 1
Loop
ErsterKW = DateAdd("WW", KW - 2, Erstertag)
End Function

Private Function KWoche(Datum As Date)
Dim t As Long
t = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
KWoche = ((Datum - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
End Function

Sub Füllen(ByVal frm As MSForms.UserForm)
Dim jCounter As Integer, KWZähler As Integer
Dim Tagzähler As Date

frm.Anzeige.Caption = Format(aktDat, "mmmm yyyy")
Tagzähler = ErsterKW(KWoche(DateSerial(Year(aktDat), Month(aktDat), 1)), Year(aktDat))
'If Tagzähler > Date And Year(frm.Anzeige) = Year(aktDat) Then
'Tagzähler = ErsterKW(KWoche(DateSerial(Year(aktDat), Month(aktDat), 1)), Year(aktDat) - 1)
'End If
KWZähler = 1
For jCounter = 1 To 6
frm.Controls("Label" & jCounter).Caption = KWoche(DateSerial(Year(aktDat), Month(aktDat), KWZähler))
KWZähler = KWZähler + 7
Next jCounter
For jCounter = 7 To 48
With frm.Controls("Label" & jCounter)
.Tag = Tagzähler
.Caption = Format(Tagzähler, "d")
.ForeColor = IIf(Month(Tagzähler) <> Month(aktDat), &HC0C0C0, IIf(Weekday(Tagzähler, 2) > 5, &HFF&, &H0&))
.BackStyle = IIf(Tagzähler = Date, 1, 0)
'.BackColor = IIf(Tagzähler = Date, &HC0FFC0, &H8000000F)
.SpecialEffect = IIf(Tagzähler = Date, 6, 0)
End With
Tagzähler = Tagzähler + 1
Next jCounter
End Sub

Klassenmodule:

Option Explicit

Public WithEvents Label As MSForms.Label

Private Sub Label_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCell.Value = Label.Tag
Unload Kalender
End Sub

Private Sub Label_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Dim i As Integer

For i = 7 To 48
If Button = 2 Then Label.ForeColor = &H80FF&
Next i
End Sub

Private Sub Label_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Dim i As Byte
Dim erst As String
Dim zweit As String

If Button = 2 Then
For i = 7 To 48
If Kalender.Controls("Label" & CStr(i)).ForeColor = &H80FF& Then
If bool = False Then
erst = Kalender.Controls("Label" & CStr(i)).Tag
bool = True
Call Füllen(Kalender)
Else
zweit = Kalender.Controls("Label" & CStr(i)).Tag
bool = False
End If
End If
Next i

If bool Then
ActiveCell.Value = erst '*** hier den ersten Eintrag ändern ***
Else
ActiveCell.Offset(0, 1).Value = zweit '*** hier den zweiten Eintrag ändern ***
End If
If Not bool Then Unload Kalender
End If
End Sub

Hajo_Zi
27.03.2012, 14:54
Du trägst kein Datum ein sondern Text, vermute ich.
ich mache mir jetzt nicht die Mühe und schaue Deinen Code durch.

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>