Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Säulenfarbe = Zellenfarbe ???





Frage

Guten Morgen zusammen, Gibt es eine Möglichkeit, die Farbe einer Säule abhängig von der Farbe der Zelle, auf die sich die Säule bezieht, zu verbinden? Konkret Wenn die Zelle blau ist, dann soll auch die Säule blau sein. Wenn die Zelle rot ist, soll die Farbe der Säule sich zu rot verändern. Ich denke dabei an eine bedingte Formatierung der Zelle, wo je nach Zahl der Hintergrund eine unterschiedliche Farbe annimmt. Dies soll sich dann auch in dem Diagramm wiederspiegeln. Danke schonmal im voraus, Tom

Antwort 1 von piano

Hallo
Hier ein Makro dazu als Muster:
Sub DiagrammFarben()
'
Dim Element As Object, Zeile1 As Integer, Spalte1 As Integer
Dim TabName As String, DiaName As String, TRange As String
Dim Zelle As Range
Dim FarbArray()
Dim i As Integer, i1 As Integer, fi As Integer

TabName = InputBox("Tabellenname der Source-Daten:", , "Vorschau")
DiaName = InputBox("Tabellenname des Diagramms:", , "Diagramm")
TRange = InputBox("Bereich der Sourcedaten (B13:E14):", , "B13:E14")

If TabName = "" Or DiaName = "" Or TRange = "" Then Exit Sub
'Farben auslesen
    Worksheets(TabName).Activate
    Range(TRange).Select
    ReDim FarbArray(1 To Selection.Count)
    fi = 0
    For Each Zelle In Selection
        fi = fi + 1
        FarbArray(fi) = Zelle.Interior.ColorIndex
    Next Zelle

'Farben zuweisen
    On Error Resume Next
    Worksheets(DiaName).Activate
    Charts(DiaName).Activate            ' wenn eigenes Chart
    ActiveSheet.chartsobjects(1).Select
    Application.ScreenUpdating = False
    fi = 1
    For i = 1 To ActiveChart.SeriesCollection.Count
    For i1 = 1 To ActiveChart.SeriesCollection(i).Points.Count
    ActiveChart.SeriesCollection(i).Points(i1).Select
    Selection.InvertIfNegative = False
    With Selection.Interior
        .ColorIndex = FarbArray(fi)
        .Pattern = xlSolid
    End With
    fi = fi + 1
    Next i1
    Next i
    Application.ScreenUpdating = True
End Sub

Viel Spaß beim ausprobieren!
Gruß piano

Es wäre nett, wenn Du ein Feedback abgeben könntest,
ob der Lösungsvorschlag Dein Problem gelöst hat.



Antwort 2 von Karneval

Hallo, habe das gleiche Problem. Habe das Makro probiert, bekomme aber Laufzeitfehler 9, Index ausserhalb des gültigen Bereichs.

Der Bereich meiner Quelldaten ist A1:B83

Vielen Dank.

Antwort 3 von piano

Hallo
Hier ein leicht modifizierter Code für Diagramm in eigenem sheet.
Dad Diagramm muß natürlich bereits erstellt sein. Getestet mit normalem Säulendiagramm:
Sub DiagrammFarbenChart()
' Für Diagramm in eigenem Sheet !!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim Element As Object, Zeile1 As Integer, Spalte1 As Integer
Dim TabName As String, DiaName As String, TRange As String
Dim Zelle As Range
Dim FarbArray()
Dim i As Integer, i1 As Integer, fi As Integer

TabName = InputBox("Tabellenname der Source-Daten:", , "Tabelle1")
DiaName = InputBox("Tabellenname des Diagramms:", , "Tabelle1")
TRange = InputBox("Bereich der Sourcedaten (B13:E14):", , "A1:B28")

If TabName = "" Or DiaName = "" Or TRange = "" Then Exit Sub
'Farben auslesen
    Worksheets(TabName).Activate
    Range(TRange).Select
    ReDim FarbArray(1 To Selection.Count)
    fi = 0
    For Each Zelle In Selection
        fi = fi + 1
        FarbArray(fi) = Zelle.Interior.ColorIndex
    Next Zelle

'Farben zuweisen
    On Error Resume Next
    Charts(DiaName).Activate
    ActiveChart.Select
    Application.ScreenUpdating = False
    fi = 1
    For i = 1 To ActiveChart.SeriesCollection.Count
    For i1 = 1 To ActiveChart.SeriesCollection(i).Points.Count
    ActiveChart.SeriesCollection(i).Points(i1).Select
    Selection.InvertIfNegative = False
    With Selection.Interior
        .ColorIndex = FarbArray(fi)
        .Pattern = xlSolid
    End With
    fi = fi + 1
    Next i1
    Next i
    ActiveChart.ChartArea.Select
    Application.ScreenUpdating = True
End Sub


Gruß piano

Es wäre nett, wenn Du ein Feedback abgeben könntest,
ob der Lösungsvorschlag Dein Problem gelöst hat.
- probieren geht über studieren -



Antwort 4 von Karneval

@piano Danke für die Mühe.

Es funktioniert aber nicht bei mir. Es macht mir alle Felder der Quelldatei (auf die sich das Diagramm beruft) farbig. Vielleicht mache ich ja auch was falsch! Ich erstelle eine einfache Datei, 2 Spalten mit Werten. Die 2. Spalte wird farbig unterschiedlich, nach den WQerten hinterlegt. das Makro habe ich vorher erstellt. jetzt erstelle ich das Diagramm und anschliessend auf das entsprechende Makro Ausführen.

Gruß Karneval

Antwort 5 von piano

Hallo
Nachtrag:
TRange = InputBox("Bereich der Sourcedaten (A1:B28):", , "B2:B28")
Hier nur den reinen Datenbereich anführen (ohne Spalten- und Zeilenüberschriften!

Antwort 6 von piano

????? funktioniert es schon ???????
Bei mir unter Office XP getestet!
Gruß piano

Es wäre nett, wenn Du ein Feedback abgeben könntest,
ob der Lösungsvorschlag Dein Problem gelöst hat.
- probieren geht über studieren -



Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: