06.02.2019, 16:09
Liebe Excel-Freunde,
ich habe immer wieder Datenmengen, bei denen ich die Daten in gestapelten Balkendiagrammen darstelle. Ich habe Bakterien und die Angabe wie Häufig das Bakterium vorkommt.
Da will ich - wenn möglich - immer die gleiche Farbe einem Bakterium zuordnen. Damit die Diagramme visuell untereinander vergleichbar sind. Jetzt habe ich im Internet ein Tutorial mit passendem VBA Code gefunden, allerdings wird mir dann immer folgende Fehlermeldung angezeigt:
"Ein Fehler ist aufgetreten (Fehler: 2147024809)".
Ich verstehe allerdings nicht warum. Ich hoffe ihr könnt mir helfen - langsam verzweifel ich
..
Code:
Liebe Grüße,
Kathrin
ich habe immer wieder Datenmengen, bei denen ich die Daten in gestapelten Balkendiagrammen darstelle. Ich habe Bakterien und die Angabe wie Häufig das Bakterium vorkommt.
Da will ich - wenn möglich - immer die gleiche Farbe einem Bakterium zuordnen. Damit die Diagramme visuell untereinander vergleichbar sind. Jetzt habe ich im Internet ein Tutorial mit passendem VBA Code gefunden, allerdings wird mir dann immer folgende Fehlermeldung angezeigt:
"Ein Fehler ist aufgetreten (Fehler: 2147024809)".
Ich verstehe allerdings nicht warum. Ich hoffe ihr könnt mir helfen - langsam verzweifel ich
..Code:
Code:
Sub Farben_Diagramm()
Dim chtDiagramm As Chart
Dim i As Integer, j As Integer, intColor As Integer, intSeries As Integer
Dim strName As String, strChart As String, strBlatt As String
On Error GoTo ErrorHandler
strBlatt = "Versuch"
strChart = "chartPersonal"
Set chtDiagramm = Sheets(strBlatt).ChartObjects(strChart).Chart
intSeries = chtDiagramm.SeriesCollection.Count
chtDiagramm.SetElement (msoElementDataLabelNone)
chtDiagramm.SetElement (msoElementDataLabelCenter)
For i = 1 To intSeries
strName = chtDiagramm.SeriesCollection(i).Name
For j = 2 To Range("rng_Orte").Value + 1
If Sheets("Versuch").Cells(j, 9).Value = strName Then
intColor = Sheets("Versuch").Cells(j, 14).Value
With chtDiagramm.SeriesCollection(strName)
.Format.Fill.Visible = msoTrue
.Format.Fill.ForeColor.RGB = RGB(Sheets("Versuch").Cells(j, 11).Value, _
Sheets("Versuch").Cells(j, 12).Value, Sheets("Versuch").Cells(j, 13).Value)
With .DataLabels.Format.TextFrame2.TextRange.Font.Fill
.ForeColor.RGB = RGB(intColor, intColor, intColor)
.Solid
End With
.DataLabels.Format.TextFrame2.TextRange.Font.Bold = msoTrue
End With
End If
Next j
Next i
Exit Sub
ErrorHandler:
MsgBox "Ein Fehler ist aufgetreten", vbInformation, "Fehler " & Err.Number
End SubLiebe Grüße,
Kathrin