Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
472to476
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
472to476
472to476
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zellmotiffarbe als RGB-Wert auslesen

Zellmotiffarbe als RGB-Wert auslesen
21.08.2004 19:32:50
HartmutM
Guten Abend,
Ich möchte die RGB-Werte der Zellfarbe (Hintergrund, Motif) auslesen. Hier im Forum fand ich dazu ein Makro, das das Ergebnis als Message-Box ausgibt. Ich möchte dieses aber so verändern, dass die Farbwerte der Zelle B12 in die Zellen C12, D12 und E12 geschrieben werden. Da ich das für alle 56 Windows-Farben machen will, soll der Vorgang bis in Zelle B68 wiederholt werden (Ergebnisse in C68, D68 und E68 schreiben). Das ursprüngliche Makro mit Message-Box lautet so:

Sub GetCellColor()
With ActiveCell
idx = ActiveCell.Interior.ColorIndex
deci = ActiveCell.Interior.Color
hexi = Hex(deci)
While Len(hexi) < 6
hexi = "0" & hexi
Wend
hexR = Mid(hexi, 5, 2) 'Hex R
hexG = Mid(hexi, 3, 2) 'Hex G
hexB = Mid(hexi, 1, 2) 'Hex B
decR = CLng("&H" & Mid(hexi, 5, 2)) 'Dec R
decG = CLng("&H" & Mid(hexi, 3, 2)) 'Dec G
decB = CLng("&H" & Mid(hexi, 1, 2)) 'Dec b
End With
msg = msg & "Dec:" & vbTab & deci & vbCrLf
msg = msg & "Hex:" & vbTab & hexi & vbCrLf
msg = msg & "Idx:" & vbTab & idx & vbCrLf
msg = msg & vbCrLf
msg = msg & vbTab & "R" & vbTab & "G" & vbTab & "B" & vbCrLf
msg = msg & "Hex:" & vbTab & hexR & vbTab & hexG & vbTab & hexB & vbCrLf
msg = msg & "Dec:" & vbTab & decR & vbTab & decG & vbTab & decB & vbCrLf
MsgBox msg, vbOKOnly, "Activecell Color Info"
End Sub

Es wäre nett, wenn mir jemand helfen könnte.
Beste Grüsse von Hartmut

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellmotiffarbe als RGB-Wert auslesen
nighty
hi hartmut :)
wie gewuenscht :)
gruss nighty

Sub GetCellColor()
Dim zeilen As Long
Dim deci As Long
Dim hexi As Variant
For zeilen = 12 To 68
With ActiveCell
deci = Cells(zeilen, 2).Interior.Color
hexi = Hex(deci)
While Len(hexi) < 6
hexi = "0" & hexi
Wend
Cells(zeilen, 3) = CLng("&H" & Mid(hexi, 5, 2))
Cells(zeilen, 4) = CLng("&H" & Mid(hexi, 3, 2))
Cells(zeilen, 5) = CLng("&H" & Mid(hexi, 1, 2))
End With
Next zeilen
End Sub

AW: Zellmotiffarbe als RGB-Wert auslesen
21.08.2004 20:37:31
HartmutM
High nighty,
Danke für Deine schnelle Hilfe. Funzt genau wie gewünscht.
Beste Grüsse von Hartmut
Anzeige
AW: Zellmotiffarbe als RGB-Wert auslesen
22.08.2004 00:48:33
HartmutM
Hallo nighty,
Leider muss ich Dich noch einmal belästigen - Dein Makro läuft zwar und schriebt die Werte dorthin wo ich will, doch ist das Ergebnis falsch bzw nicht gewünscht.
Zur Erinnerung: Ich will den AKTUELLEN RGB-Wert der Zellfarbe auslesen.
Hier die Beispiele:
Das ursprüngliche Makro liest wirklich die aktuellen Farben aus:

Sub GetCellColor()
With ActiveCell
idx = ActiveCell.Interior.ColorIndex
deci = ActiveCell.Interior.Color
hexi = Hex(deci)
While Len(hexi) < 6
hexi = "0" & hexi
Wend
hexR = Mid(hexi, 5, 2) 'Hex R
hexG = Mid(hexi, 3, 2) 'Hex G
hexB = Mid(hexi, 1, 2) 'Hex B
decR = CLng("&H" & Mid(hexi, 5, 2)) 'Dec R
decG = CLng("&H" & Mid(hexi, 3, 2)) 'Dec G
decB = CLng("&H" & Mid(hexi, 1, 2)) 'Dec b
End With
msg = msg & "Dec:" & vbTab & deci & vbCrLf
msg = msg & "Hex:" & vbTab & hexi & vbCrLf
msg = msg & "Idx:" & vbTab & idx & vbCrLf
msg = msg & vbCrLf
msg = msg & vbTab & "R" & vbTab & "G" & vbTab & "B" & vbCrLf
msg = msg & "Hex:" & vbTab & hexR & vbTab & hexG & vbTab & hexB & vbCrLf
msg = msg & "Dec:" & vbTab & decR & vbTab & decG & vbTab & decB & vbCrLf
MsgBox msg, vbOKOnly, "Activecell Color Info"
End Sub

Doch Dein Makro errechnet die RGB-Werte die dem Windows-Farbindex (bei Reset.Color)entsprechen:

Sub GetCellColor2()
' von nighty (Excel-Forum, 21.08.2004)
Dim zeilen As Long
Dim deci As Long
Dim hexi As Variant
For zeilen = 11 To 66
With ActiveCell
deci = Cells(zeilen, 2).Interior.Color
hexi = Hex(deci)
While Len(hexi) < 6
hexi = "0" & hexi
Wend
Cells(zeilen, 3) = CLng("&H" & Mid(hexi, 5, 2))
Cells(zeilen, 4) = CLng("&H" & Mid(hexi, 3, 2))
Cells(zeilen, 5) = CLng("&H" & Mid(hexi, 1, 2))
End With
Next zeilen
End Sub

Ich kann beim besten Willen (aber schlechten VBA-Kenntnissen) nicht sehen, wo der Fehler ist....
Danke für Deine Hilfe
Gute Nacht
Hartmut
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige