Letzte Datenpunkte beschriften

Sub ltztr_Dtpkt() Dim p, r As Integer Dim i% ActiveSheet.ChartObjects("Diagramm 1").Activate ' r = ActiveChart.SeriesCollection.Count ' MsgBox r 'For i = 1 To r p = ActiveChart.SeriesCollection(1).Points.Count ' MsgBox k With ActiveChart.SeriesCollection(1).Points(p) .HasDataLabel = True End With ActiveChart.SeriesCollection(1).DataLabels(p).Select Selection.ShowSeriesName = True Selection.ShowValue = True With Selection.Format.Fill .Visible = msoTrue .ForeColor.RGB = RGB(255, 255, 255) .Solid End With With Selection.Format.Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) End With ' Next i ' Next r End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ltztr_Dtpkt() Dim p, r As Integer Dim i% With ActiveSheet.ChartObjects("Diagramm 1").Chart For i = 1 To .SeriesCollection.Count p = .SeriesCollection(i).Points.Count With .SeriesCollection(i).Points(p) .HasDataLabel = True With .DataLabel .ShowSeriesName = True .ShowValue = True .Interior.Color = 255 With .Format.Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) End With End With End With Next i End With End Sub

Sub ltztr_Dtpkt() Dim p, r As Integer Dim i% With Charts("Diagramm1") For i = 1 To .SeriesCollection.Count If .SeriesCollection(i).Name "Reihe 2" Then .SeriesCollection(i).HasDataLabels = True .SeriesCollection(i).DataLabels.Delete p = .SeriesCollection(i).Points.Count With .SeriesCollection(i).Points(p) .HasDataLabel = True With .DataLabel .ShowSeriesName = True .ShowValue = True .Interior.Color = 255 With .Format.Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) End With End With End With End If Next i End With End Sub

Sub ltztr_Dtpkt2() Dim p, r As Integer Dim i% ' With ActiveSheet.ChartObjects("DiagrammFT").Chart 'Charts("DiagrammFT").Activate 'Charts("DiagrammFT").Select With Charts("DiagrammFT") For i = 1 To .SeriesCollection.Count p = .SeriesCollection(i).Points.Count With .SeriesCollection(i).Points(p) .HasDataLabel = True With .DataLabel .ShowSeriesName = True .ShowValue = True .Interior.Color = RGB(255, 255, 255) With .Format.Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) End With End With End With Next i End With End Sub

Sub ltztr_Dtpkt2() Dim p, r As Integer Dim i% Dim strY As String Dim rngY As Range With Charts("DiagrammFT") For i = 1 To .SeriesCollection.Count If .SeriesCollection(i).Name = "Probe1" Or _ .SeriesCollection(i).Name = "Probe 2" Then .SeriesCollection(i).HasDataLabels = True .SeriesCollection(i).DataLabels.Delete strY = Split(.SeriesCollection(i).Formula, ",")(2) Set rngY = Range(strY) For p = rngY.Cells.Count To 1 Step -1 If Not IsError(Range(strY).Cells(p).Value) Then Exit For End If Next p With .SeriesCollection(i).Points(p) .HasDataLabel = True With .DataLabel .ShowSeriesName = True .ShowValue = True .Interior.Color = RGB(255, 255, 255) With .Format.Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) End With End With End With End If Next i End With End Sub

Hi Thomas,
es gibt verschiedene Möglichkeiten festzustellen, ob ein Datenpunkt einen Zahlenwert (oder einen Fehlerwert) enthält. Man kann z.B. die Values der Datenreihe in ein Array schreiben und dieses dann in einer Schleife durchlaufen.
Oder man kann aus der Datenereihenformel den Zellbereich ermitteln, in welchem die Y-Werte stehen und diesen Zellbereich dann mit demselben Ziel durchlaufen. Die Datenreihenformel siehst du in der Bearbeitungsleiste wenn du eine Datenreihe markiert hast.
An dieser Codezeile musst du also nichts ändern, denn damit wird der Zellbereich für die Y-Werte aus der Datenreihenformel der laufenden Datenreihe extrahiert - Split(.SeriesCollection(i).Formula, ",")(1) extrahiert den Zellbereich der X-Werte und Split(.SeriesCollection(i).Formula, ",")(2) den Zellbereich der Y-Werte jeweils als String. In der nächsten For-Schleife wird dann jede Zelle dieses Bereichs von der letzten bis zur ersten durchlaufen und geprüft, ob sie einen Zahlenwert enthält - wenn ja, dann die Schleife verlassen weil dies der letzte Punkt (bzw. von hinten der erste) ist, der beschriftet werden soll.
Wenn du mehr als nur 2 Datenreihen hast die beschriftet werden sollen bietet sich statt einer If-Anweisung eine Select Case-Anweisung an, weil es damit einfacher ist:

       For i = 1 To .SeriesCollection.Count
Select Case .SeriesCollection(i).Name
Case "Probe1", "Probe 2"    '

Hi Thomas,
der Fehler tritt auf, wenn in einer der Spalten in Tabelle "Daten" auschließlich Fehlerwerte stehen. Weshalb es zu einem Fehler kommt kann man prüfen, indem man den Code im Einzelschrittmodus durchläuft und sich die Inhalte der Variablen in der betreffenden Codezeile anschaut - was bei dir i und p wären. Die Variable i ist immer belegt, da der Zähler ja von der letzten bis zur erstern Datenreihe läuft und somit nur die Datenreihen angesprochen werden die im Diagramm auch tatsächlich vorhanden sind. Also muss der Fehler bei der Variablen p liegen - und siehe da: wenn die Datenreihe nur Fehlerwerte beinhaltet beträgt p am Ende des Schleifendruchlaufs 0 und einen Datenpunkt 0 gibt es selbstverständlich nicht, ergo besagte Fehlermeldung. Aus diesem Grund muss noch eine Prüfung eingebaut werden, dass p immer größer 0 sein muss.

                Case Worksheets("0°_60°C").Range("B9"), Worksheets("0°_60°C").Range("C9"), _
Worksheets("0°_60°C").Range("D9"), Worksheets("0°_60°C").Range("E9"), _
Worksheets("0°_60°C").Range("F9"), Worksheets("0°_60°C").Range("G9"), _
Worksheets("0°_60°C").Range("H9")
strY = Split(.SeriesCollection(i).Formula, ",")(2)
Set rngY = Range(strY)
For p = rngY.Cells.Count To 1 Step -1
If Not IsError(Range(strY).Cells(p).Value) Then
Exit For
End If
Next p
If p > 0 Then
.SeriesCollection(i).HasDataLabels = True
.SeriesCollection(i).DataLabels.Delete
With .SeriesCollection(i).Points(p)
.HasDataLabel = True
With .DataLabel
.ShowSeriesName = True
.ShowValue = True
.Interior.Color = RGB(255, 255, 255)
With .Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
End With
End With
End With
End If
End Select

Dabei kann man auch noch das Hinzufügen und wieder Löschen der Beschriftungslabel innerhalb der Fehlerbehandlung ausführen, weil dies andernfalls ja nicht erforderlich ist und den Code nur ausbremst.
Wenn du nicht die Zellbezüge sondern die definierten Namen in die Case-Zeile schreiben willst, dann halt einfach
Case Range("DeinName1"), Range("DeinName2"), Range("DeinName3") usw.

With Charts("DiagrammFT") For i = 1 To .SeriesCollection.Count Select Case .SeriesCollection(i).Name Case Worksheets("0°_60°C").Range("B9"), Worksheets("0°_60°C").Range("C9"), _ Worksheets("0°_60°C").Range("D9"), Worksheets("0°_60°C").Range("E9"), _ Worksheets("0°_60°C").Range("F9"), Worksheets("0°_60°C").Range("G9"), _ Worksheets("0°_60°C").Range("H9") If .SeriesCollection(i).Name "" Then strY = Split(.SeriesCollection(i).Formula, ",")(2) Set rngY = Range(strY) For p = rngY.Cells.Count To 1 Step -1 If Not IsError(Range(strY).Cells(p).Value) Then Exit For End If Next p If p > 0 Then .SeriesCollection(i).HasDataLabels = True .SeriesCollection(i).DataLabels.Delete With .SeriesCollection(i).Points(p) .HasDataLabel = True With .DataLabel .ShowSeriesName = True .ShowValue = True .Interior.Color = RGB(255, 255, 255) With .Format.Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) End With End With End With End If End If End Select Next i End With

Beliebteste Forumthreads (12 Monate)

25
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

26 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Letzte Datenpunkte beschriften

25 Beiträge zum Forumthread Beiträge zu diesem Forumthread

26 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

25
Beiträge zum Forumthread

Beiträge zu diesem Forumthread