Zusammengeschusterter Code
26.03.2006 22:14:18
Bluey
Wenn ihr das Projekt kompiliert, treten Probleme mit den Arrays auf, weshalb
ich mein Projekt hier veröffentliche!
P.S.: Ihr solltet die gefärbten Textpassagen in der Zelle mit dem Color-Index 15
färben, da sonst Probleme entstehen könnten, da ich noch nicht alle Indize definiert habe!
THANX FPR HELP!
MFG
BLEUY
[code]
Sub ProjektAusprobieren()
Dim Beginners As Variant
Dim Enders As Variant
Dim Colors As Variant
Beginners = Array("<blau>", "<rot>")
Enders = Array("</blau>", "</rot>")
Colors = Array(5, 7)
GetColorCellText Range("A1"), Colors, Beginners, Enders
End Sub
Public
Sub GetColorCellText(TRange As Range, ColorDescriptors As Variant, _
BeginDescriptors As Variant, EndDescriptors As Variant)
Dim BeginPushes()
Dim EndPushes()
Dim ColorPushes()
i = 0
Inputsource = TRange.Text
Char = 0
While Char < UBound(ColorDescriptors)
While Char < Len(Inputsource) 'Jedes Zeichen - nicht mehr als die.
Char = Char + 1
Length = Char 'Neuer Versuch
If TRange.Characters(Char, Length). _
Font.ColorIndex = ColorDescriptors(i) Then
BeginPushes(UBound(EndPushes)) = Char 'Dem Array anfügen
ColorPushes(UBound(ColorPushes)) = i 'Den Index des besagten Colors anfügen
End If
CharEndPos = Char
Do 'Anzahl betroffener Zeichen ermitteln
CharEndPos = CharEndPos + 1
If TRange.Characters(CharEndPos, 1). _
Font.ColorIndex <> ColorDescriptors(i) Then
EndPushes(UBound(EndPushes)) = CharEndPos 'Dem Array anfügen
Exit Do
End If
Loop
Wend
Wend
Workstack = Inputsource
While element < UBound(EndPushes) 'Jeden Push-Array durchlurchen
Workstack = PushString(CStr(Workstack), CStr(BeginPushes(element)), 1, CStr(BeginDescriptors(ColorPushes(element)))) 'BeginDescriptor in den Text
Workstack = PushString(CStr(Workstack), CStr(EndPushes(element)), 1, CStr(EndDescriptors(ColorPushes(element)))) 'EndDescriptorsDescriptor in den Text
element = element + 1
Wend
MsgBox "RESULT: " & Workstack
End Sub
Public
Function PushString(Sourcestring As String, BeginPos As Integer, EndPos As Integer, InputString As String)
FirstStack = Left(Sourcestring, EndPos)
EndStack = Right(Sourcestring, BeginPos)
PushString = FirstStack & InputString & EndStack
End Function
[/code]