Bspws wie folgt, wobei ich hierbei einerseits ...
29.03.2012 20:00:09
Luc:-?
…Jochens For Each-Ansatz für ganze Zell-Bereiche beibehalten habe, Stef@n,
weil das die Universalität der udFkt erhöht (Einsatz in MatrixFmln!), obwohl es für den Einsatz in BedFmt-Bedingungsfmln eher hinderlich wäre, denn darin sind Bereichsbezüge (MatrixFmln) verboten. Außerdem habe ich auch noch einige andere Möglichkeiten eingebaut, falls du das mal anders benötigst; habe nämlich was gg „Insellösungen”(!). Im 2.Argument kannst du die festlegen: fehlt es oder gibst du -1 an → fette, -2 → kursive, -3 → fett-kursive Textteile, >0 → FarbIndex für farbige Textteile: 1-56 nur farbig, 101-156 außerdem fett, 201-256 außerdem kursiv, 301-356 außerdem fett-kursiv. Beachte, dass sowohl ein FarbIndex 0 als auch jeweils ab 57-100 zu einem Fehler führen würde.
Function IsHiLited(Bereich As Range, Optional ByVal HLTyp As Integer = -1)
Const CIxAnz As Long = 100
Dim zwErg() As Boolean, cc As Long, i As Long, j As Long, rc As Long, z As Integer, _
bez As Range
On Error Resume Next
rc = Bereich.Rows.Count: cc = Bereich.Columns.Count
Redim zwErg(rc - 1, cc - 1)
For Each ber In Bereich
For z = 1 To Len(ber)
With ber.Characters(z, 1).Font
Select Case HLTyp
Case -3: zwErg(i, j) = .Bold And .Italic
Case -2: zwErg(i, j) = .Italic
Case -1: zwErg(i, j) = .Bold
Case Is > 0: zwErg(i, j) = .ColorIndex = HLTyp Mod CIxAnz
If zwErg(i, j) And CBool(HLTyp \ CIxAnz) Then
Select Case HLTyp \ CIxAnz
Case 1: zwErg(i, j) = .Bold
Case 2: zwErg(i, j) = .Italic
Case 3: zwErg(i, j) = .Bold And .Italic
End Select
End If
End Select
End With
If zwErg(i, j) Then Exit For
Next z
j = (j +1) Mod cc: i = i - CInt(j = 0) 'Anm: Bei DFeldern umgekehrt!
Next ber
If IsError(UBound(zwErg, 2)) Then 'Anm: Dam.b.EzlZBezug in BedFmt k.DFeld entsteht!
If CBool(UBound(zwErg)) Then IsHiLited = zwErg Else IsHiLited = zwErg(0)
ElseIf CBool(UBound(zwErg, 1) + UBound(zwErg, 2)) Then
IsHiLited = zwErg
Else: IsHiLited = zwErg(0, 0)
End If
Set Bereich = Nothing
End Function
Den Test der udFkt muss ich leider ganz allein dir überlassen, da ich zZ an einer Linux-Maschine sitze. Also melden, wenn was nicht klappt.
Fml für BedFmt wäre dann in etwa so: Formel ist… =IsHiLited(A1)
Brauchst du mal mehr, musst du Arg2 mit angeben.
Gruß Luc :-?