Office: Prüfen ob in Graph eine Series vorhanden ist

Beverly · 22. Juli 2014

Hi Bire,

prüfe vorher, ob die Datenreihe einen Namen hat oder ob dieser leer ist.

Bire · 23. Juli 2014

Hallo Karin,

vielen Dank für die schnell Rückmeldung. Wie genau mache ich das?

Besten Dank und Grüße

bire

Bire · 23. Juli 2014

Hallo Luschi,

vielen Dnak für die Rückmeldung. Ich werde es heute Abend ausprobieren.

Das mit dem Aktivieren und Selectrieren muss ich mir wirklich abgewöhnen. Aber ich bin dann immer froh wenn es läuft.

Und Objekt-Variablen waren nochmal??

Beste Grüße und vielen Dnak

bire

Beverly · 23. Juli 2014

Hi Bire,

vom Prinzip her kannst du das so lösen:

Code:

' 'Tiefstellen das a0
ActiveChart.SeriesCollection(62).Points(e).DataLabel.Select
If Application.Count(Worksheets("Hill Chart").Range("$R$151:$R$" & 151 + e - 1)) >= e Then
Selection.Format.TextFrame2.TextRange.Characters(2, 1).Font.BaselineOffset = -0.25
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Es wird geprüft, ob es überhaupt einen Datenpunkt an der gewünschten Stelle gibt.

Zu Select und Activate hast du ja bereits eine Aussage. Für die Datenreihen 61 und 62 würde der Code dann so aussehen:

Code:

With ActiveSheet.ChartObjects("Diagramm_Modell").Chart
'##################
'Datenreihe 61
'##################
With .SeriesCollection.NewSeries
.Name = "='Hill Chart'!$M$149:$O$149"
.XValues = "='Hill Chart'!$O$151:$O$200"
.Values = "='Hill Chart'!$N$151:$N$200"
With .Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
End With
With .Points(d)
.ApplyDataLabels ShowSeriesName:=True
With .DataLabel
.Position = xlLabelPositionCenter
.ShowSeriesName = -1
.ShowValue = 0
'Tiefstellen das a0
With .Format.TextFrame2.TextRange
If Application.Count(Worksheets("Hill Chart").Range("$O$151:$O$" & 151 + d - 1)) >= d Then
.Characters(2, 1).Font.BaselineOffset = -0.25
End If
.Font.Bold = msoTrue
.Font.Size = 8
With .Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 255)
.Transparency = 0
.Solid
End With
End With
With .Format.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
End With

End With
End With
End With

'##################
'Datenreihe 62
'##################
With .SeriesCollection.NewSeries

.Name = "='Hill Chart'!$P$149:$R$149"
.XValues = "='Hill Chart'!$Q$151:$Q$200"
.Values = "='Hill Chart'!$R$151:$R$200"
.Border.Color = vbMagenta
With .Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
End With
With .Points(d)
.ApplyDataLabels ShowSeriesName:=True
With .DataLabel
.Position = xlLabelPositionCenter
.ShowSeriesName = -1
.ShowValue = 0
'Tiefstellen das a0
With .Format.TextFrame2.TextRange
If Application.Count(Worksheets("Hill Chart").Range("$Q$151:$Q$" & 151 + e - 1)) >= e Then
.Characters(2, 1).Font.BaselineOffset = -0.25
End If
.Font.Bold = msoTrue
.Font.Size = 8
With .Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 255)
.Transparency = 0
.Solid
End With
End With
With .Format.Fill
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
End With
End With
End With
End With
' ... hier die weiteren Datenreihen
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bire · 23. Juli 2014

Hallo Luschi,

vielen Dnak für den Code. Ich habe ihn jetzt ausporbiert und irgendwie komme ich nicht dahint, warum er bei mir nicht richtig funktioniert.

Wenn ich denn Code "normal" laufen lassen, wird das zweite Zeichen nicht tiefgestellt. Lasse ich den Code mit dem Debugger laufen, dann schon.

An was könnte das liegen? Für die Reihe 61 sieht mein Code so aus:

Code:

Sub diagrammfuellen_oeffnung_mod()

Dim o As Object
Dim i As Integer

'##################
'Datenreihe 61
'##################

ActiveSheet.ChartObjects("Diagramm_Modell").Activate
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(61).Name = "='Hill Chart'!$M$149:$O$149"
ActiveChart.SeriesCollection(61).XValues = "='Hill Chart'!$O$151:$O$200"
ActiveChart.SeriesCollection(61).Values = "='Hill Chart'!$N$151:$N$200"

ActiveSheet.ChartObjects("Diagramm_Modell").Activate
ActiveChart.SeriesCollection(61).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
End With

With ActiveChart.SeriesCollection(61).Points(d)
.ApplyDataLabels ShowSeriesName:=True
End With
'Auskommentiert, da ich diesen Code nach Deiner Anpassung nicht benötige, 'oder???
' ActiveChart.SeriesCollection(61).Points(d).DataLabel.Select
' Selection.Position = xlLabelPositionCenter
' Selection.ShowSeriesName = -1
' Selection.ShowValue = 0

Set o = ActiveChart.SeriesCollection(61).Points(d).DataLabel
o.Position = xlLabelPositionCenter
o.ShowSeriesName = -1
o.ShowValue = 0

'Tiefstellen das a0
i = Len(o.Format.TextFrame2.TextRange.Text)
If i > 1 Then
o.Format.TextFrame2.TextRange.Characters(2, 1).Font.BaselineOffset = -0.25
End If
Set o = Nothing
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

@ Karin: Deinen Code werde ich später auch noch ausprobieren.

Vielen, vielen Dank euch beiden. Ihr habt mich wirklich gerettet.

Beste Grüße

Bire

Bire · 23. Juli 2014

Hallo Karin,

leider kommt direkt bei der ersten SeriesCollection folgender Laufzeitfehler:

Laufzeitfehler 424 - Objekt erforderlich.

An was kann des liegen?

Vielen Dank..

bire

Beverly · 23. Juli 2014

Hi Bire,

da ich deinen jetzigen Code nicht kenne, kann ich dazu leider nichts sagen. Ich habe meinen geposteten Code mit Datenreihe 61 und 62 getestet und dort funktioniert er fehlerlos.

Bire · 23. Juli 2014

Hallo Karin,

vielen Dank für Deine Hilfe.

vom Prinzip her kannst du das so lösen:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

So habe ich es jetzt auch gelöst.

Kann es sein, dass Dein Code nicht funktioniert, da ich vor den Serien 61 &62 noch weitere habe, oder nicht?

Auf jeden Fall vielen Dank für die Geduld und die super Hilfe. Wirklich. Vielen, vielen Dank.

Beste Grüße

Bire

Beverly · 23. Juli 2014

Hi Bire,

die Ursache ist m.E. darin zu sichen, dass die Grafik durch die vielen Datenreihen nicht in der Lage ist, sich jeweils komplett aufzubauen und deshalb im Beschriftungslabel noch kein Text vorhanden ist, der formatiert werden kann. Eine Lösung dafür ist mir leider nicht bekannt.

Mal eine generelle Frage: wenn ich das richtig verstehe, löschst du zu Beginn alle Datenreihen und erstellst sie dann komplett wieder neu mit allen entsprechenden Formatierungen - was ist der Sinn des Ganzen?

Bire · 29. Juli 2014

Hallo Karin, Hallo Luschi,

nochmals vielen Dank an euch beide. Ich bin jetzt einen riesen Schritt weitergekommen.

Wirklich top, dass ihr euch so reinhängt.

Weiter so.

Beste Grüße

Bire

Beverly · 29. Juli 2014

Hi Bire,

ich möchte gewiss nicht aufdringlich erscheinen, aber vielleicht könnte man ja einiges wesentlich vereinfachen, wenn du genau beschreiben würdest, was du erreichen willst. Mir erschließt sich der Sinn nicht, weshalb du das Diagramm immer wieder neu zeichnen lässt, indem du zuerst alle Datenreihen löschst und sie danach wieder genau so erstellst wie sie waren - es sind doch immer die selben Spalten bzw. Zellbereiche, die du bei jedem Code-Durchlauf den Datenreihen zuweist. Was spricht denn dagegen, alle Datenreihen zu belassen wie sie sind? Sie ändern ihren Verlauf doch automatisch, wenn sich die Daten ändern.

Bire · 31. Januar 2015

Hallo Karin,

Der Grund warum ich die Datenreihen nicht so belasse wie sie sind, ist folgender. Sobald die neuen Daten der Datenreihen eingetragen werden, verschieben sich die Datenwerte, da ich nicht immer die selbe Anzahl von Daten pro Datenreihe habe. Beispiel Spalte 2, könnte in einem Fall 50 Daten haben und im Fall 2 nur 25 haben. Deshalb lösche ich alle vorhandenen Datenreihen und lasse diese nochmals von neuem Zeichnen.

Jetzt hat ja alles wunderbar funktioniert, leider kam mein Chef auf mich zu das Excel-Werkzeug so anzupassen, dass die Spaltenanzahl dynamisch ausgeführt wird. Das habe ich mittlerweile hinbekommen.

Wo ich jetzt noch Probleme habe, sind die Formatierungen der einzelenen Datenreihen, bzw. der Datenpunkte.

Die erste Datenreihe soll nur mit einem X-Dargestellt werden, da diese immer nur aus einem Datenpaar besteht (einem x- und einen y-Wert) ab Datenreihe 2 bis n_serien sollen sie als ganz normal als Punkte x und y dargestellt werden.

Nun zu meinem Problem. Wie muss ich die

Code:

With ChartAbj ...
.......
.....
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Anpassen, damit ich meine Datenreihen, die Datennamen ect. formatieren kann?
Hier mein ganzer Code:

Code:

Sub format_chart()

Dim LastRow As Long
Dim LastColumn As Long
Dim ColumnCount, n_serien As Long

Dim wsChart As Worksheet
Dim ChartObj As ChartObject

Dim n As Long

Dim i, loop_delete As Integer
Dim u As Integer
Dim NameRng As String
Dim xRng, yRng As Range
Dim CountsRng As Range

' LastRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
' LastColumn = ActiveSheet.Cells(8, Columns.Count).End(xlToLeft).Column
' ColumnCount = LastColumn - 4
' Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & " LastRow: " & LastRow)

'##########################################################
'Eventuell anzupassen ist der Name des Sheets ("Tabelle1")
'##########################################################

Set wsChart = ThisWorkbook.Sheets("Tabelle1")
wsChart.Activate

'#####################################################################
'Eventuell anzupassen ist der Name des ChartObjects("Diagramm_Modell")
'#####################################################################

Set ChartObj = ActiveSheet.ChartObjects("Diagramm_Modell")

'##################################################
'Löscht alle Datenreihen
'##########################################

ActiveSheet.ChartObjects("Diagramm_Modell").Activate
With ActiveChart
For n = .SeriesCollection.Count To 1 Step -1
.SeriesCollection(n).Delete
Next n
End With

'#############################################
'Eventuell anzupassen sind die Laufvariablen
'#############################################

ColumnCount = 6

For i = 2 To ColumnCount Step 2
u = i + 2
n_serien = i / 2

'##################################################
'Der Spaltenname und die x und f(x) Werte einlesen
'##################################################

With Sheets("Tabelle1")
NameRng = .Cells(24, i + 1).Value
Set xRng = .Range(.Cells(26, i), .Cells(32, i))
Set yRng = .Range(.Cells(26, i + 1), .Cells(32, i + 1))
End With

'###################################################################
'Der Spaltenname und die x und f(x) Werte in das Diagramm schreiben
'###################################################################

With ChartObj.Chart.SeriesCollection.NewSeries
.XValues = xRng
.Values = yRng
.Name = NameRng
End With

If n_serien = 1 Then

With ChartObj
.MarkerStyle = xlMarkerStyleX
.MarkerSize = 10

With .SeriesCollection(i)
.Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
.Selection.Format.TextFrame2.TextRange.Font.Size = 8
End With

With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 255)
.Transparency = 0
.Solid
End With

With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.Transparency = 0
.Solid
End With
End With

Else

'Wird noch eingefügt...

End If

Next i

'###############################################
'Anzeige der x- und f(x) anpassen
'##########################################

' With ChartObj.Chart
' .SetElement (msoElementLegendBottom)
' .Axes(xlValue).MajorUnit = 1
' .Axes(xlValue).MinorUnit = 0.5
' .Axes(xlValue).MinorTickMark = xlOutside
' '.Axes(xlCategory).TickLabels.NumberFormat = "#,##000"
' .Axes(xlCategory).TickLabels.NumberFormat = "#,##0"
' '.Location Where:=xlLocationAsObject, Name:="Plot"
' End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich würde mich über eine kurze Rückmeldung sehr freuen.

Vielen Dank und noch ein schönes Wochenende

Bire

Office: Prüfen ob in Graph eine Series vorhanden ist

Prüfen ob in Graph eine Series vorhanden ist

Prüfen ob in Graph eine Series vorhanden ist

Prüfen ob in Graph eine Series vorhanden ist

Prüfen ob in Graph eine Series vorhanden ist

Prüfen ob in Graph eine Series vorhanden ist - Similar Threads - Prüfen Graph Series

Zelle per VBA auf ihren Inhalt prüfen und reagieren sowie bei Änderung

Prüfung unterschiedlicher Zellen auf Inhalt und Konsequenz

mit String aus Formular Übereinstimmung in Abfrage prüfen

Wartungstermine prüfen und ausgeben

zwei Zellen prüfen steht was drinnen dann schreib text

Mehrere Auswertungen zum prüfen von Nichtnormal- und Normalverteilung

wert aus ComboBox prüfen dann hinzufügen