Das richtige Pgm dürfte wie folgt aussehen, ...
03.08.2014 19:19:11
Luc:-?
…bitte austauschen!
Rem Passt BedFormatTextFarbe/Fett an UntBedingg lt Legende an
' Anwendg d.Dynamized Conditional Formatting f.Vss vor Xl12
Private Sub ActCForm()
Const naCFArea$ = "BedFormBereich", naCFAreaDat$ = "BedFormFallBereich"
Dim FallSp As Long, ic As Long, ix As Long, relFWo As Variant, _
cfr As Range, relCFBer As Range, relCFLeg As Range
On Error Resume Next
Application.EnableEvents = False
Set relCFBer = Me.Range(naCFArea): Set relCFLeg = Me.Range(naCFLegd)
FallSp = Me.Range(naCFAreaDat).Column - relCFBer.Cells(1).Column + 1
relFWo = WorksheetFunction.Transpose(relCFLeg)
For Each cfr In relCFBer.Rows
If cfr.FormatConditions.Count >= 2 Then
ix = 0: ix = WorksheetFunction.Match(Int(Now) - Int(cfr.Cells(FallSp)), relFWo)
If CBool(ix) Then
For ic = 1 To 2
With cfr.FormatConditions(ic)
.Font.Color = relCFLeg.Cells(ix).Font.Color
.Font.Bold = relCFLeg.Cells(ix).Font.Bold
End With
Next ic
End If
End If
Next cfr
Set relCFBer = Nothing: Set relCFLeg = Nothing
Application.EnableEvents = True
End Sub
Luc :-?