Shape an Füllfarbe anpassen

Rolf_Ernst · 27. Oktober 2011 um 14:09

Hallo zusammen,

hab’ mal wieder ein Problemchen:

mit folgendem Code weise ich Shape 1, 3 und 4 die Füllfarbe
der Zellen C8, C13 und D17 zu.

 Sub shape\_faerben()
 
 Dim cell1 As Range
 Dim cell2 As Range
 Dim cell3 As Range

 Dim shape1 As Shape
 Dim shape3 As Shape
 Dim shape4 As Shape

 Set cell1 = Range("c8")
 Set cell2 = Range("c13")
 Set cell3 = Range("d17")
 
 Set shape1 = ActiveSheet.Shapes(1)
 Set shape3 = ActiveSheet.Shapes(3)
 Set shape4 = ActiveSheet.Shapes(4)

 shape1.OLEFormat.Object.Interior.Color = cell1.Interior.Color
 shape3.OLEFormat.Object.Interior.Color = cell2.Interior.Color
 shape4.OLEFormat.Object.Interior.Color = cell3.Interior.Color

 End Sub

Per Schaltfläche funktioniert das, wenn Zellen und Shapes auf dem
selben Tabellenblatt sind.

Frage:

Wie kann ich das automatisch auslösen, dass sich die Shapefarbe
ändert, wenn ich die Zellfarbe ändere?

Die Shapes befinden sich auf Tabelle1, die zugehörigen
Zellen auf Tabelle2.

Kann jemand helfen?

Gruß und danke
Rolf

Thomas_Ramel · 27. Oktober 2011 um 14:21

Grüezi Rolf

Frage:

Wie kann ich das automatisch auslösen, dass sich die
Shapefarbe ändert, wenn ich die Zellfarbe ändere?

Gar nicht - es gibt in Excel kein Ereignis das ausgelöst wird, wenn nur die Formatierung einer Zelle verändert wird!
Excel ist zur Berechnung von Werten und Inhalten konzipiert, nicht im Zusammenhang mit Formatierungen.

Du müsstes also auf andere Events zurückgreifen (z.B. das SelectionChange() oder Calculate()), was dann aber einen unter umständen erheblichen Overhead mit sich bringt.

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

Rolf_Ernst · 28. Oktober 2011 um 06:41

Danke

Hallo Thomas

Frage:

Wie kann ich das automatisch auslösen, dass sich die
Shapefarbe ändert, wenn ich die Zellfarbe ändere?

Gar nicht - es gibt in Excel kein Ereignis das ausgelöst wird,
wenn nur die Formatierung einer Zelle verändert wird!
Excel ist zur Berechnung von Werten und Inhalten konzipiert,
nicht im Zusammenhang mit Formatierungen.

Schade auch, mann kann nicht alles haben.
Trotzdem vielen Dank.

Allen ein schönes Wochenende.

Gruß
Rolf

Reinhard_fb8cb7 · 28. Oktober 2011 um 11:24

Hallo Rolf,

mit folgendem Code weise ich Shape 1, 3 und 4 die Füllfarbe
der Zellen C8, C13 und D17 zu.

Per Schaltfläche funktioniert das, wenn Zellen und Shapes auf
dem
selben Tabellenblatt sind.

? Soll das bedeuten wenn sie auf verschiedenen Blättern sind klappt das nicht? Sicher, dazu mußt du den Code umschreiben bei der Blattreferenzierung, kriegste das nicht hin?

Wie kann ich das automatisch auslösen, dass sich die
Shapefarbe
ändert, wenn ich die Zellfarbe ändere?

Direkt geht das nicht wie Thomas schon schrieb, aber es geht indirekt, nimm halt irgendein Blattereignis, wie z.B. dieses:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call shape_faerben
End Sub

Oder aber du machst einen Doppelklick auf die Spezialzellen:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.Dialogs(84).Show
Call shape_faerben
ActiveCell.Offset(1, 0).Select
End Sub

Gruß
Reinhard

Reinhard_fb8cb7 · 28. Oktober 2011 um 11:27

Korrektur
Hallo Rolf,

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.Dialogs(84).Show
Call shape_faerben
End Sub

Gruß
Reinhard

Rolf_Ernst · 31. Oktober 2011 um 07:22

Moin Reinhard,

danke für Dein Interesse-

mit folgendem Code weise ich Shape 1, 3 und 4 die Füllfarbe
der Zellen C8, C13 und D17 zu.

Per Schaltfläche funktioniert das, wenn Zellen und Shapes auf
dem
selben Tabellenblatt sind.

? Soll das bedeuten wenn sie auf verschiedenen Blättern sind
klappt das nicht? Sicher, dazu mußt du den Code umschreiben
bei der Blattreferenzierung, kriegste das nicht hin?

Ich wollte das erstmal auf demselbn Blatt hinbekommen,
aber ich habe die Quellzellen jetzt mal auf Tabelle2 gesetzt:

Sub shape\_faerben()
 
 Dim cell1 As Range
 Dim cell2 As Range
 Dim cell3 As Range

 Dim shape1 As Shape
 Dim shape3 As Shape
 Dim shape4 As Shape
 
 Sheets("Tabelle2").Activate

 Set cell1 = Range("c8")
 Set cell2 = Range("c13")
 Set cell3 = Range("d17")

 Sheets("Tabelle1").Activate

 Set shape1 = ActiveSheet.Shapes(1)
 Set shape3 = ActiveSheet.Shapes(3)
 Set shape4 = ActiveSheet.Shapes(4)

 shape1.OLEFormat.Object.Interior.Color = cell1.Interior.Color
 shape3.OLEFormat.Object.Interior.Color = cell2.Interior.Color
 shape4.OLEFormat.Object.Interior.Color = cell3.Interior.Color

 End Sub

Wie kann ich das automatisch auslösen, dass sich die
Shapefarbe
ändert, wenn ich die Zellfarbe ändere?

Direkt geht das nicht wie Thomas schon schrieb, aber es geht
indirekt, nimm halt irgendein Blattereignis, wie z.B. dieses:

> Private Sub Worksheet\_SelectionChange(ByVal Target As Range)  
> Call shape\_faerben  
> End Sub

Das funktioniert leider nicht. Es passiert nix.

Oder aber du machst einen Doppelklick auf die Spezialzellen:

(Das ist Deine Korrektur)

Private Sub Worksheet\_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.Dialogs(84).Show
Call shape\_faerben
End Sub

Da passiert auch nix.
Ist wahrscheinlich noch zu früh für mich…

Gruß
Rolf

Reinhard_fb8cb7 · 31. Oktober 2011 um 08:22

Hallo Rolf,

Wie kann ich das automatisch auslösen, dass sich die
Shapefarbe ändert, wenn ich die Zellfarbe ändere?

Direkt geht das nicht wie Thomas schon schrieb, aber es geht
indirekt, nimm halt irgendein Blattereignis, wie z.B. dieses:

Das funktioniert leider nicht. Es passiert nix.

dann wird der Blattereigniscode im falschen Blatt steht.
In deinem Fall gehört dieser Code in das BlattModul von Tabelle1:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.Dialogs(84).Show
Call shape_faerben
End Sub

In ein Standardmodul Modul1 o.ä. gehört dann dieser Code:

Sub shape\_faerben()
With Worksheets("Tabelle2")
 .shape1.OLEFormat.Object.Interior.Color = Range("C8").Interior.Color
 .shape3.OLEFormat.Object.Interior.Color = Range("C13").Interior.Color
 .shape4.OLEFormat.Object.Interior.Color = Range("D17").Interior.Color
End With
End Sub

Gruß
Reinhard

Rolf_Ernst · 31. Oktober 2011 um 12:23

Hallo Reinhard,

dann wird der Blattereigniscode im falschen Blatt steht.
In deinem Fall gehört dieser Code in das BlattModul von
Tabelle1:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,
Cancel As Boolean)
Cancel = True
Application.Dialogs(84).Show
Call shape_faerben
End Sub

In ein Standardmodul Modul1 o.ä. gehört dann dieser Code:

Sub shape_faerben()
With Worksheets(„Tabelle2“)
.shape1.OLEFormat.Object.Interior.Color =
Range(„C8“).Interior.Color
.shape3.OLEFormat.Object.Interior.Color =
Range(„C13“).Interior.Color
.shape4.OLEFormat.Object.Interior.Color =
Range(„D17“).Interior.Color
End With
End Sub

Klappt leider immer noch nicht, ich habe mal das Beispiel drangehängt
mit Deinem Code drin:

http://www.file-upload.net/download-3845244/Shape_fa…

Die Zellen C8, C13 + D17 in Tabelle 2 erhalten ihre Farbe durch eine
bedingte Formatierung. Kann man dieses „Ereignis“ nicht abgreifen,
um die Shapes auf Tabellenblatt 1 zu färben?

Gruß
Rolf

Reinhard_fb8cb7 · 31. Oktober 2011 um 14:14

Excel VBA und Zellfarben
Hallo Rolf,

http://www.file-upload.net/download-3845244/Shape_fa…

muß ich mir noch anschauen.

Die Zellen C8, C13 + D17 in Tabelle 2 erhalten ihre Farbe
durch eine
bedingte Formatierung. Kann man dieses „Ereignis“ nicht
abgreifen,
um die Shapes auf Tabellenblatt 1 zu färben?

Direkt „abgreifen“ geht da genausowenig wie wenn du die Zellen manuell färbst.
Es löst also kein Ereignis aus.

Es wäre schön gewesen, bitte beim nächsten Mal darauf achten, wenn du gleich angegeben hättest das die Zellen durch bed. Formatierung gefärbt werden. Das ist ein Riesenunterschied zu manuell.

Die Farbe von manuell gefärbten Zellen kann man mit
.Interior.Colorindex auslesen, die Farbe von durch bed. Formatierung
gefärbten Zellen NICHT.

In dem Fall muß man im Code die bed. Formatierungen auswerten, mal kurz gesagt.

Zum Verständnis ein Kurzbeispiel.
Mit bed. Formatierung weist du A1 Farben zu, Formeln der Bedingungen:
=A1>=B1 —>Blau
=A1Rot

Wenn du nun das Doppelklick-Ereignis für A1 nimmst,
so sieht das in etwa so aus (teilw. Pseudocode:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address(0, 0) „A1“ Then Exit Sub
If Target.Value>=Target.0ffset(0,1).Value then Shape1=Blau
If Target.Value „B1“ Then Exit Sub
If Target.Value=Target.0ffset(0,1).Value then Shape1=Rot
End Sub

agieren und spart sich den Doppelklick.

Versuche die Beispiele bitte zu verstehen.
Dann wird es leichter meine evtl. Lösungen zu verstehen und viel wichtiger auch mal selbst auf andere Gegebenheiten anzupassen.

Gruß
Reinhard

Rolf_Ernst · 31. Oktober 2011 um 16:02

Hallo Reinhard,

http://www.file-upload.net/download-3845244/Shape_fa…

muß ich mir noch anschauen.

das wäre hübsch.

Die Zellen C8, C13 + D17 in Tabelle 2 erhalten ihre Farbe
durch eine
bedingte Formatierung. Kann man dieses „Ereignis“ nicht
abgreifen,
um die Shapes auf Tabellenblatt 1 zu färben?

Direkt „abgreifen“ geht da genausowenig wie wenn du die Zellen
manuell färbst.
Es löst also kein Ereignis aus.

Es wäre schön gewesen, bitte beim nächsten Mal darauf achten,
wenn du gleich angegeben hättest das die Zellen durch bed.
Formatierung gefärbt werden. Das ist ein Riesenunterschied zu
manuell.

Ja, sorry, habe ich nicht bedacht.

Die Farbe von manuell gefärbten Zellen kann man mit
.Interior.Colorindex auslesen, die Farbe von durch bed.
Formatierung
gefärbten Zellen NICHT.

In dem Fall muß man im Code die bed. Formatierungen auswerten,
mal kurz gesagt.

Zum Verständnis ein Kurzbeispiel.
Mit bed. Formatierung weist du A1 Farben zu, Formeln der
Bedingungen:
=A1>=B1 —>Blau
=A1Rot

Wenn du nun das Doppelklick-Ereignis für A1 nimmst,
so sieht das in etwa so aus (teilw. Pseudocode:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,
Cancel As Boolean)
If Target.Address(0, 0) „A1“ Then Exit Sub
If Target.Value>=Target.0ffset(0,1).Value then Shape1=Blau
If Target.Value „B1“ Then Exit Sub
If Target.Value=Target.0ffset(0,1).Value then Shape1=Rot
End Sub

Ich habe das jetzt mal so für meinen Zewck geändert:

Private Sub Worksheet\_Change(ByVal Target As Range)
If Target.Address(3, 8) "F8" Then Exit Sub '-\> (3,8) = Zeile 3, Spalte8?
If Target.Value ist rot: Syntaxfehler. und wofür steht (0,1)?
If Target.Value\>=Target.0ffset(0,1).Value then Shape1=Rot
End Sub

agieren und spart sich den Doppelklick.

Das ist immernoch mein Ziel.

Versuche die Beispiele bitte zu verstehen.

Naja - manchmal klappt es

Dann wird es leichter meine evtl. Lösungen zu verstehen und
viel wichtiger auch mal selbst auf andere Gegebenheiten
anzupassen.

Das ist immer ein Erfolgserlebnis.

Gruß
Rolf

Reinhard_fb8cb7 · 31. Oktober 2011 um 19:48

http://www.file-upload.net/download-3845244/Shape_fa…

muß ich mir noch anschauen.

das wäre hübsch.

Hallo Rolf,

bezogen auf deine Mappe:

In das Modul von Tabelle2:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range(„F8,H8,F13,H13,F17,H17“)) Is Nothing Then Exit Sub
Call shape_faerben
End Sub

In ein Standardmodul:

Option Explicit

Sub shape\_faerben()
With Worksheets("Tabelle1")
 .Shapes("Rectangle 1").OLEFormat.Object.Interior.Color = Farbe(Range("C8"))
 .Shapes("Rectangle 3").OLEFormat.Object.Interior.Color = Farbe(Range("C13"))
 .Shapes("Rectangle 4").OLEFormat.Object.Interior.Color = Farbe(Range("D17"))
End With
End Sub

Function Farbe(Zelle) As Long
Select Case Zelle.Value
 Case Is 

Gruß
Reinhard

Rolf_Ernst · 1. November 2011 um 07:01

http://www.file-upload.net/download-3845244/Shape_fa…

muß ich mir noch anschauen.

Moin Reinhard,

bezogen auf deine Mappe:

In das Modul von Tabelle2:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range(„F8,H8,F13,H13,F17,H17“)) Is
Nothing Then Exit Sub
Call shape_faerben
End Sub

In ein Standardmodul:

Option Explicit

Sub shape_faerben()
With Worksheets(„Tabelle1“)
.Shapes(„Rectangle 1“).OLEFormat.Object.Interior.Color =
Farbe(Range(„C8“))
.Shapes(„Rectangle 3“).OLEFormat.Object.Interior.Color =
Farbe(Range(„C13“))
.Shapes(„Rectangle 4“).OLEFormat.Object.Interior.Color =
Farbe(Range(„D17“))
End With
End Sub

Function Farbe(Zelle) As Long
Select Case Zelle.Value
Case Is

Vielen Dank für Deine Hilfe. Darauf wäre ich nicht wirklich gekommen.
Aber woher nimmst Du die Farbnummern? Die Shapefarben passen nicht
zu den Zellfarben. Aus der GRB-Tabelle konnte ich auch keine passenden
Codes ermitteln.
*ratlosbin*

Gruß
Rolf

Rolf_Ernst · 1. November 2011 um 12:05

Danke
Hallo Reinhard,

Aber woher nimmst Du die Farbnummern? Die Shapefarben passen
nicht zu den Zellfarben. Aus der GRB-Tabelle konnte ich auch keine
passenden Codes ermitteln.

Hat sich erledigt.
Hier gefunden:
http://www.herber.de/forum/archiv/944to948/t944606.h…

Funzt jetzt prima.
Vielen dank für Deine Unterstützung.

Gruß
Rolf

Reinhard_fb8cb7 · 2. November 2011 um 16:31

Re: Danke
Hallo Rolf,

http://www.herber.de/forum/archiv/944to948/t944606.h…

Funzt jetzt prima.

Schön für dich, aber ich hab da ein Problem.
Die Farbcodes von mir waren rein zufällig hingeschrieben.
Ging ja erstmal darum den Code bei dir zum Laufen zu bringen.
Welche Farbe genau ist da erstmal zweitrangig.

Was da in dem Link steht kenn ich alles. Trotzdem bekam ich es nicht hin deinen Shapes da die Zellenfarben zuzuweisen, die Farben sehen anders aus.

Ich habe aus den drei Zellen die Farbcodes der Zellen ausgelesen, also nicht die Farbnummern 0-56, sondern die „Color“-Werte.
Weise ich diese den Shapes zu so sehen die farblich anders aus.

Okay hab ich mir gedacht, dann mach ich es gründlich.
Ich habe den Farbnummern 36-38 die Farbcodes (quasi RGB) der ausgelesenen Farbcodes zugewiesen.

Das habe ich schon via bed. Formatierung gemacht und überwacht.

Dann halt C8,C13,D17 die farbennummern 36-38 zugwiesen.
Dann den Shapes (Rectangles, ist aber wurscht) auch diese farbnummern zugewiesen.

Es kann nicht anders sein, entweder habe ich einen Fehler gemacht, leicht möglich, oder da gibt es etwas was ich nicht weiß oder weiß aber grad nicht darauf komm, Thomas zu Hüüüüülf *bitt*

*Fluch* Immer noch sahen da die farben unterschiedlich aus
Jetzt bin ich äußerst überrascht daß es bei dir klappt, was ja schön für dich ist, ich hab ein riesiges Fragezeichen

Lade bitte da die Mappe hoch und sag mir bitte ob du da an den Standardfarbeinstellungen „rumgefummelt“ hast und welche Excelversion du hast.

Vielen dank für Deine Unterstützung.

Danke, gerne.

Gruß
Reinhard