Geburtstagskarte - Farbige Wörter per VBA erzeugen

[Lago]

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.

[schauan]

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

[Lago]

O.K.  ich werde mal am Wochende oder so anfangen zu basteln.

[
Dateiupload bitte im Forum! So geht es: Klick mich!
]

[Kuwer]

Hallo,

Modul Modul1

Option 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

[Lago]

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.

[Lago]

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

[Lago]

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