ich verwende Office 2016.
Ich möchte die Farbe von bestimmten Wörtern in einer Zelle ändern.
Dieses soll automatisch passieren, wenn der Inhalt einer Zelle geändert wurde.
Der automatische Aufruf des Markos funktioniert soweit.
Für das Ändern der Schriftware, wollte ich ein Makro verwenden. Dieses habe ich nicht selbst geschrieben. Ich habe es im Internet gefunden.
Beim Ausführen des Makros erhalte immer "Laufzeitfehler 424, Objekt erforderlich".
Die Meldung kommt in dieser Zeile:
With Data_List.Cells(1).CurrentRegion.Columns(7)
Data_list ist dabei der Name des Tabellenblattes.
Kann mir da jemand weiterhelfen und das ans Laufen bringen? Ich habe kaum VBA Kenntnisse.
Folgend das komplette Makro:
Sub WoerterFaerben()
Dim iavarDaten As Long
Dim avarDaten As Variant
Dim iavarWort As Variant
Dim avarWort As Variant
Dim intFarbe As Integer
Dim rngBereich As Range
Dim intWortStart As Integer
Dim intWortLaenge As Integer
Dim colWortFarbe As Collection
With Data_List.Cells(1).CurrentRegion.Columns(7)
Set rngBereich = .Cells
avarDaten = .Value2
End With
Set colWortFarbe = New Collection
colWortFarbe.Add 4, CStr("erled.") ' 3 = rot
colWortFarbe.Add 4, CStr("Erledigt") ' 3 = rot
'colWortFarbe.Add 4, CStr("geprüft") ' 4 = grün
'colWortFarbe.Add 45, CStr("Import") ' 45 = orange
rngBereich.Font.ColorIndex = xlColorIndexAutomatic
On Error Resume Next
For iavarDaten = LBound(avarDaten) To UBound(avarDaten)
If avarDaten(iavarDaten, 1) Empty Then
avarWort = Split(avarDaten(iavarDaten, 1), " ")
For iavarWort = LBound(avarWort) To UBound(avarWort)
intFarbe = colWortFarbe(avarWort(iavarWort))
If intFarbe > 0 Then
intWortStart = InStr(avarDaten(iavarDaten, 1), avarWort(iavarWort))
intWortLaenge = Len(avarWort(iavarWort))
rngBereich.Cells(iavarDaten, 1).Characters(intWortStart, intWortLaenge)
_ .Font.ColorIndex = intFarbe
intFarbe = 0
Else
Err.Clear
End If
Next
End If
Next
On Error GoTo 0
End Sub
Vielen Dank!
Beste Grüße