Regenbogen-Zellen:)

Forumthread: Regenbogen-Zellen:)

Regenbogen-Zellen:)

24.12.2005 16:01:30

Kolja

Hallo alle miteinander!!
Ich habe da ein Makro problem, und ich hoffe ihr helft mir dabei ;)
Ich möchte ein Makro schreiben, das in Word einen Text, Zeichen für zeichen, in den Farben des Regenbogens färbt. Und das abhängig von der Anzahl der Zeichen pro zeile. Nun ist es mir nicht gelungen, eine Formel zu finden, sie es mir erlaubt, einen regenbogen in seinen Farbbestandteilen zu berrechnen. Und da dachte ich mir stell doch mal die frage an dieses Forum, vielleicht weiß da jemand mehr...
Um es excel-lastiger zu machen,wäre es vielleicht am einfachsten ein demo-makro zu erstellen, das anhand einer Zahlenvorgabe (entspricht den zeichen meines textes und in der Tabelle den zeilen) in eine Tabelle die RGB-werte einträgt und eine Zelle daneben entsprechen einfärbt.
Ich hoffe daraus genug zu erlernen um es dann in Word umzusetzen...
Danke schon mal im Voraus und natürlich euch allen eingesegnetes Weihnachtsfest, ob ihr es den nun feiert oder nicht, den ein bisschen Friede-Freude-ZimtApfelKuchen kann glaube ich jeder gebrauchen!!!
Kolja

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Regenbogen-Zellen:)

24.12.2005 17:58:17

Josef
AW: Regenbogen-Zellen:)

26.12.2005 16:21:16

Kolja

AW: Regenbogen-Zellen:)

24.12.2005 17:58:17

Josef

Hallo Kolja!
Hier ein Makro für Word!
Die Sub "Regenbogen" färbt deinen Text! (Auswahl oder ganzes Dokument!)
Den restlichen Code packst du am besten in ein eigenes Modul!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Regenbogen()
Dim hsl As HSLCol
Dim RGBLong As Long
Dim iCnt As Integer, intIndex As Integer, intStep As Integer

'Mit den Werten von Lum, Sat und intStep ein wenig Experimentieren!

hsl.Lum = 125
hsl.Sat = 190
intStep = 1

With ThisDocument.Range ' Selection 'Ganzes Dokument(dauert) oder Auswahl!

  For iCnt = 1 To Len(.Text)
    If .Characters(iCnt) <> " " Then
      hsl.Hue = intIndex
      RGBLong = HSLtoRGB(hsl)
      .Characters(iCnt).Font.Color = RGB(RGBRed(RGBLong), RGBGreen(RGBLong), RGBBlue(RGBLong))
      intIndex = intIndex + intStep
      If intIndex > 255 Then intIndex = 0
    End If
  Next

End With

End Sub

' **********************************************************************
' Modul: basHSL Typ: Allgemeines Modul
' **********************************************************************

'By: Chris Jennings

'Description: HSL, Hue Saturation and Luminance, Is a "colour reference model" often chosen
'to express colours because it uses more "natural" values- as opposed to RGB. The following
'program is a simple dialog allowing the convertion from HSL to RGB and back again.
'You can perform both operations at the same time on one form so you can see how accurate
'the convertion is. I compared the results I got to the colour picker display in both
'Paint Shop Pro and Adobe Photoshop and found the convertion to be quite accurate.
'There are also inbuilt functions for splitting long colour values into seperate RGB values.
'PURE VB code- no OCX's, DLL's or even API calls. I'm sure lots of you out there will find
'this very usefull. ;)
'This file came from Planet-Source-Code.com...the home millions of lines of source code
'You can view comments on this code/and or vote on it at:
'
'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=52733&lngWId=1
'
'The author may have retained certain copyrights to this code...
'please observe their request and the law by reviewing all copyright conditions
'at the above URL.

Option Explicit
Const HSLMAX As Long = 255
'H, S and L values can be 0 - HSLMAX. 240 matches what is used by MS Win;
'any number less than 1 byte is OK; works best if it is evenly divisible by 6
Const RGBMAX As Long = 255
'R, G, and B value can be 0 - RGBMAX
Const UNDEFINED As Long = 0
'Hue is undefined if Saturation = 0 (greyscale)

Public Type HSLCol 'Datatype used to pass HSL Color values
  Hue As Long
  Sat As Long
  Lum As Long
End Type

Public Function RGBRed(RGBCol As Long) As Long
'Return the Red component from an RGB Color
RGBRed = RGBCol And &HFF
End Function

Public Function RGBGreen(RGBCol As Long) As Long
'Return the Green component from an RGB Color
RGBGreen = ((RGBCol And &H100FF00) \ &H100)
End Function

Public Function RGBBlue(RGBCol As Long) As Long
'Return the Blue component from an RGB Color
RGBBlue = (RGBCol And &HFF0000) \ &H10000
End Function

Private Function iMax(a As Long, B As Long) As Long
'Return the Larger of two values
iMax = IIf(a > B, a, B)
End Function

Private Function iMin(a As Long, B As Long) As Long
'Return the smaller of two values
iMin = IIf(a < B, a, B)
End Function

Public Function RGBtoHSL(RGBCol As Long) As HSLCol
'Returns an HSLCol datatype containing H ue, Luminescence
'and Saturation; given an RGB Color value
Dim R As Long, G As Long, B As Long
Dim cMax As Long, cMin As Long
Dim RDelta As Double, GDelta As Double, BDelta As Double
Dim H As Double, s As Double, L As Double
Dim cMinus As Long, cPlus As Long

R = RGBRed(RGBCol)
G = RGBGreen(RGBCol)
B = RGBBlue(RGBCol)

cMax = iMax(iMax(R, G), B) 'Highest and lowest
cMin = iMin(iMin(R, G), B) 'color values

cMinus = cMax - cMin 'Used to simplify the
cPlus = cMax + cMin 'calculations somewhat.

'Calculate luminescence (lightness)
L = ((cPlus * HSLMAX) + RGBMAX) / (2 * RGBMAX)

If cMax = cMin Then 'achromatic (r=g=b, greyscale)
  s = 0 'Saturation 0 for greyscale
  H = UNDEFINED 'Hue undefined for greyscale
Else
  'Calculate color saturation


  If L <= (HSLMAX / 2) Then
    s = ((cMinus * HSLMAX) + 0.5) / cPlus
  Else
    s = ((cMinus * HSLMAX) + 0.5) / (2 * RGBMAX - cPlus)
  End If

  'Calculate hue
  RDelta = (((cMax - R) * (HSLMAX / 6)) + 0.5) / cMinus
  GDelta = (((cMax - G) * (HSLMAX / 6)) + 0.5) / cMinus
  BDelta = (((cMax - B) * (HSLMAX / 6)) + 0.5) / cMinus



  Select Case cMax
    Case Clng(R)
      H = BDelta - GDelta
    Case Clng(G)
      H = (HSLMAX / 3) + RDelta - BDelta
    Case Clng(B)
      H = ((2 * HSLMAX) / 3) + GDelta - RDelta
  End Select

  If H < 0 Then H = H + HSLMAX
End If

RGBtoHSL.Hue = Clng(H)
RGBtoHSL.Lum = Clng(L)
RGBtoHSL.Sat = Clng(s)
End Function

Public Function HSLtoRGB(HueLumSat As HSLCol) As Long
Dim R As Long, G As Long, B As Long
Dim H As Long, L As Long, s As Long
Dim Magic1 As Long, Magic2 As Long
H = HueLumSat.Hue
L = HueLumSat.Lum
s = HueLumSat.Sat

If s = 0 Then 'Greyscale
  R = (L * RGBMAX) / HSLMAX 'luminescence,
  'converted to the proper range
  G = R 'All RGB values same in greyscale
  B = R


  If H <> UNDEFINED Then
    'This is technically an error.
    'The RGBtoHSL routine will always return
    '
    'Hue = UNDEFINED when Sat = 0.
    'if you are writing a color mixer and
    'letting the user input color values,
    'you may want to set Hue = UNDEFINED
    'in this case.
  End If
Else
  'Get the "Magic Numbers"


  If L <= HSLMAX / 2 Then
    Magic2 = (L * (HSLMAX + s) + (HSLMAX / 2)) / HSLMAX
  Else
    Magic2 = L + s - ((L * s) + (HSLMAX / 2)) / HSLMAX
  End If
  Magic1 = 2 * L - Magic2
  'get R, G, B; change units from HSLMAX range
  'to RGBMAX range
  R = (HuetoRGB(Magic1, Magic2, H + (HSLMAX / 3)) * RGBMAX + (HSLMAX / 2)) / HSLMAX
  G = (HuetoRGB(Magic1, Magic2, H) * RGBMAX + (HSLMAX / 2)) / HSLMAX
  B = (HuetoRGB(Magic1, Magic2, H - (HSLMAX / 3)) * RGBMAX + (HSLMAX / 2)) / HSLMAX
End If
HSLtoRGB = RGB(Cint(R), Cint(G), Cint(B))
End Function

Private Function HuetoRGB(mag1 As Long, mag2 As Long, Hue As Long) As Long
'Utility function for HSLtoRGB
'Range check

If Hue < 0 Then
  Hue = Hue + HSLMAX
ElseIf Hue > HSLMAX Then
  Hue = Hue - HSLMAX
End If
'Return r, g, or b value from parameters
'

Select Case Hue 'Values get progressively larger.
    'Only the first true condition will exec
    ' ute
  Case Is < (HSLMAX / 6)
    HuetoRGB = (mag1 + (((mag2 - mag1) * Hue + (HSLMAX / 12)) / (HSLMAX / 6)))
  Case Is < (HSLMAX / 2)
    HuetoRGB = mag2
  Case Is < (HSLMAX * 2 / 3)
    HuetoRGB = (mag1 + (((mag2 - mag1) * ((HSLMAX * 2 / 3) - Hue) + (HSLMAX / 12)) / (HSLMAX / 6)))
  Case Else
    HuetoRGB = mag1
End Select
End Function

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Regenbogen-Zellen:)

26.12.2005 16:21:16

Kolja

Funktioniert Spitzenmässig!!!
Mann muss allerdings das erste "Option Explicit" weglassen..:)
Vielen Vielen Dank!!!!
Kolja

Infobox / Tutorial

Schritt-für-Schritt-Anleitung

Öffne Excel und erstelle eine neue Tabelle.
Füge die RGB-Werte für die Regenbogenfarben in die Zellen ein. Eine einfache Farbenfolge könnte so aussehen:
- Rot: 255,0,0
- Orange: 255,127,0
- Gelb: 255,255,0
- Grün: 0,255,0
- Blau: 0,0,255
- Indigo: 75,0,130
- Violett: 148,0,211

Erstelle ein Makro:

Gehe zu „Entwicklertools“ und klicke auf „Visual Basic“.
Füge ein neues Modul ein und kopiere den folgenden Code:

Sub RegenbogenZellen()
    Dim i As Integer
    Dim rgbValues As Variant
    rgbValues = Array("255,0,0", "255,127,0", "255,255,0", "0,255,0", "0,0,255", "75,0,130", "148,0,211")

    For i = 0 To UBound(rgbValues)
        Cells(i + 1, 1).Interior.Color = RGB(Split(rgbValues(i), ",")(0), Split(rgbValues(i), ",")(1), Split(rgbValues(i), ",")(2))
    Next i
End Sub

Führe das Makro aus, um die Zellen in den Farben des Regenbogens einzufärben.

Häufige Fehler und Lösungen

Fehler: Das Makro läuft nicht.

Lösung: Stelle sicher, dass die Entwicklertools aktiviert sind. Überprüfe auch, ob die „Option Explicit“ Zeile im Modul vorhanden ist, da sie die Deklaration von Variablen erzwingt.

Fehler: Die Farben sind nicht korrekt.

Lösung: Überprüfe die RGB-Werte in deinem Makro. Sie müssen im richtigen Format eingegeben werden.

Alternative Methoden

Verwendung von Word: Wenn du die Regenbogenschrift in Word erstellen möchtest, kannst du die gleichen RGB-Werte verwenden. Der Code in Word wäre ähnlich, aber du würdest die Characters-Methode verwenden, um den Text direkt zu formatieren.
Grafiksoftware: Du kannst auch Tools wie Photoshop nutzen, um einen Text in Regenbogenfarben zu erstellen und diesen dann in Word einzufügen.

Praktische Beispiele

Beispiel 1: Verwende die oben genannten RGB-Werte, um eine einfache Excel-Tabelle zu erstellen, die die Farben des Regenbogens darstellt.
Beispiel 2: In Word kannst du eine Tabelle einfügen und mit dem Regenbogen-Makro die Zellen entsprechend einfärben.

Sub RegenbogenWord()
    Dim hsl As HSLCol
    Dim RGBLong As Long
    Dim iCnt As Integer, intIndex As Integer, intStep As Integer

    hsl.Lum = 125
    hsl.Sat = 190
    intStep = 1

    With ThisDocument.Range
        For iCnt = 1 To Len(.Text)
            If .Characters(iCnt) <> " " Then
                hsl.Hue = intIndex
                RGBLong = HSLtoRGB(hsl)
                .Characters(iCnt).Font.Color = RGB(RGBRed(RGBLong), RGBGreen(RGBLong), RGBBlue(RGBLong))
                intIndex = intIndex + intStep
                If intIndex > 255 Then intIndex = 0
            End If
        Next iCnt
    End With
End Sub

Tipps für Profis

Experimentiere mit HSL-Werten: Um die Farben noch lebendiger zu gestalten, kannst du die HSL-Werte im Makro anpassen. Dies wird dir helfen, die perfekte word schrift regenbogenfarben zu finden.
Nutze Formeln in Excel: Berechne die RGB-Werte mithilfe von Excel-Formeln, um dynamisch Farben zu generieren, die sich je nach Benutzerinteraktion ändern.

FAQ: Häufige Fragen

1. Wie kann ich die Farben anpassen? Du kannst die RGB-Werte im Makro einfach ändern, um andere Farben zu verwenden.

2. Funktioniert das auch in älteren Excel-Versionen? Ja, die oben genannten Schritte sind mit Excel 2010 und späteren Versionen kompatibel. Beachte, dass einige Funktionen in älteren Versionen möglicherweise nicht verfügbar sind.

3. Wie füge ich das Makro in Word ein? Der Prozess ist ähnlich wie in Excel. Öffne den Visual Basic-Editor in Word und füge den Makro-Code dort ein.

4. Gibt es eine Möglichkeit, den Text direkt in Word zu formatieren, ohne ein Makro zu verwenden? Ja, du kannst manuell die Schriftfarbe für jeden Buchstaben ändern, aber dies ist zeitaufwendig. Ein Makro ist hier viel effizienter.

Beliebteste Forumthreads (12 Monate)