PDA

Vollständige Version anzeigen : Rot geschriebene Zellen ausgeben mit Zeilenumbruch


Beni0
20.07.2012, 12:31
Hallo,
ich habe folgendes Problem, ich habe in meinem gesamten Excel Dokument mehrere Zellen in denen was Rot geschrieben wurde. Diese Möchte ich jeweils in meiner TextBox ausgeben mit einem Zeilenumbruch, da es mehrere rot geschriebene Zellen geben.

Bisher bin ich soweit gekommen:
Code:

For Each Zelle In ActiveSheet
If Application.WorksheetFunction.IsText(Zelle.Value) Then
For z = 1 To Len(Zelle.Value)
If Zelle.Characters(z, 1).Font.Color = True Then
Text = Text & Zelle.Characters(z, 1).Text
End If
Next z
TxtBoxHinweis.Value = "&Text&"
Text = " "
End If
Next Zelle



Leider funktioniert das nicht ganz so wie ich will :-( kann mir da einer weiterhelfen?

Vielen Dank schonmal für die Mühe im vorraus

Hajo_Zi
21.07.2012, 09:20
Ich baue keine Datei nach, die Zeit hat schon jemand investiert. Ein Link zur Datei wäre nicht schlecht.

<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>

GMG-CC
22.07.2012, 11:23
Hallo Beni0,

bitte setze hier Codezeilen mit Einrückungen ein dann sind sie besser lesbar. Das geht über das Symbol oben in der Symbolleiste. Wäre es nicht dein erster Beitrag gewesen, dann hätte ich erst gar nicht weiter gelesen ...

So ganz klar ist mir nicht, was du erreichen willst. Vielleicht hilft aber dieser Code weiter:
Sub Hugo()
Dim Zelle As Range
Dim z As Integer
Dim rot As Integer
Dim strText As String

rot = 255
strText = ""

For Each Zelle In ActiveSheet.UsedRange
If Application.WorksheetFunction.IsText(Zelle) Then
For z = 1 To Len(Zelle)
If Zelle.Characters(z, 1).Font.Color = rot Then
If strText > "" Then strText = strText & Chr(10)
strText = strText & Mid(Zelle, z, 1)
End If
Next z
' TxtBoxHinweis.Value = "&strText&"
' strText = " "
End If
Next Zelle
MsgBox strText
End Sub

FromThePast
22.07.2012, 11:50
Hallo, Beni0,

statt den gesamten Bereich zu durchlaufen würde ich SpecialCells für Texte einsetzen:

Dim rngZelle As Range

'Fehler ausschalten, wenn keine Texteinträge vorhanden sind
On Error Resume Next
For Each rngZelle In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, 2)
Debug.Print rngZelle.Address
Next rngZelle

'Auswertung, ob es währen der Laufzeit einen Fehler gegeben hat
If Err <> 0 Then
MsgBox "Keine Textzellen gefunden!"
Err.Clear
End If

'Fehlerbehandlung zurücksetzen auf normal
On Error GoTo 0
Bleibt die Frage, ob nur einzelne Buchstaben in rot geschrieben wurden oder die kompletten Zellen - dann könnte man ab Excel2007 nach den Formaten der Zellen suchen lassen...

Ciao,
Holger