Hallo Clever-Excel Leute,
ich habe wieder einen Satz in der Zelle A1 gegeben und möchte per VBA aus diesem Satz farbige Wörter machen.
Die zufällig gewählte Farbe innerhalb der Wörter soll dann aber gleich sein. Also bunt aber nicht zu bunt.
Leider funktioniert bei so etwas die Split Funktion nicht, da die Farbe mit dieser Funktion nicht übertragen wird.
Also wird die Sache für mich hier schon recht kompliziert. Ihr wisst sicherlich sofort wie man so etwas macht.
Hallöchen,
gib mal in der Suche die Begriffe wort farbe ein. Da erhälst Du ca. 3 - 4 Treffer. In dem Thread von Nobody schaust Du Dir die Antwort 8 an
O.K. ich werde mal am Wochende oder so anfangen zu basteln.
[
Dateiupload bitte im Forum! So geht es: Klick mich!]
Hallo,
Modul Modul1Option Explicit
Sub FaerbeWoerter()
Dim i As Long, lngP() As Long
Dim rngT As Range
Dim varT As Variant
Set rngT = ActiveCell ' Range("A5")
varT = rngT.Value
If Len(varT) Then
'harte Zeilenumbrüche werden durch Leerzeichen ersetzt
varT = Application.Substitute(varT, Chr(10), Chr(32))
'Wörter werden in Feldvariable abgelegt
varT = Split(varT, Chr(32))
'2. Datenfeld für das Ablegen der Wortpositionen wird dimensioniert
Redim lngP(Ubound(varT))
'Wortpositionen werden ermittelt und abgelegt
lngP(0) = 1
For i = 1 To Ubound(varT)
lngP(i) = lngP(i - 1) + Len(varT(i - 1)) + 1
Next i
'jedes 2. Wort wird rot gefärbt
For i = 0 To Ubound(lngP) Step 2
rngT.Characters(lngP(i), Len(varT(i))).Font.ColorIndex = 3
Next i
End If
End Sub
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0
Gruß Uwe
Hallo Uwe,
vielen Dank schon mal für deine Anleitung. Deine 2 farbige Darstellung
von Wörtern klappt super. Werde darauf aufbauend meinen eigenen
Code entwickeln, damit dann alle Wörter in meinem Satz farbig erscheinen.
Den Code für meinen Satz mit farbig dargestellten Wörtern, habe ich jetzt fertig. Mich würde jetzt aber noch interessieren,
wie es hinbekommen könnte, dass jede Farbe im Satz nur einmal erscheint.
z.B.:
Code:
Sub Farbige_Wörter_Erzeugen()
Dim vbstr
Range("A1") = "Ein ganz bunter Satz mit sehr vielen einzelnen darin enthaltenen Wörtern."
vbstr = Split(Range("A1"))
vbPos = 1
For i = 0 To UBound(vbstr)
Range("A1").Characters(vbPos, Len(vbstr(i))).Font.ColorIndex = WorksheetFunction.RandBetween(-1, 55)
'Nächstes Leerzeichen finden:
vbPos = InStr(vbPos + Len(vbstr(i)), Range("A1"), " ") + 1
Next
End Sub
oder so:
Code:
Sub Farbige_Wörter_ErzeugenII()
Dim vbstr, vbPos
Range("A1") = "Ein ganz bunter Satz mit sehr vielen einzelnen darin enthaltenen Wörtern."
vbstr = Split(Range("A1"))
vbPos = 1
For i = 0 To UBound(vbstr)
Range("A1").Characters(vbPos, Len(vbstr(i))).Font.ColorIndex = WorksheetFunction.RandBetween(-1, 55)
'Nächstes Leerzeichen finden:
vbPos = Len(Split(WorksheetFunction.Substitute(Range("A1"), " ", Chr(181), i + 1), Chr(181))(0)) + 2
Next
End Sub
Codeergänzung, nach Bastelarbeiten farbige Wörter mit Split-Funktion erzeugen.
Code:
Sub Farbige_Wörter_Erzeugen_mit_SplitFunktion()
Dim vbPos As Integer, i As Integer, vbArray As Variant
vbArray = Array(3, 4, 7, 8, 26, 30, 32, 46)
Range("A1") = "Ein ganz bunter Satz mit sehr vielen einzelnen darin enthaltenen Wörtern."
vbPos = 1
For i = 0 To UBound(Split(Range("A1")))
vbPos = InStr(vbPos, Range("A1"), Split(Range("A1"))(i))
Range("A1").Characters(vbPos, Len(Split(Range("A1"))(i))).Font.ColorIndex = _
vbArray(WorksheetFunction.RandBetween(0, UBound(vbArray)))
Next
End Sub