Liniendiagramm mit Beschriftung

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Label
Bild

Betrifft: Liniendiagramm mit Beschriftung
von: Airwin Rooker
Geschrieben am: 01.09.2015 10:40:12

Hi Comunity,
jetzt habe ich noch ein Problem, ich habe ein Liniendiagramm, welches sich jede Woche erweitert. Nun möchte ich, den letzten sichtbaren Datenpunkt mit dem Datenreihennamen beschriften.
Gibt es hierfür eine raschere Lösung als jeden einzelnen Punkt anzuwählen + Datenbeschriftung hinzufügen?
Danke vorweg.
LG Airwin
https://www.herber.de/bbs/user/99942.xlsx

Bild

Betrifft: AW: Liniendiagramm mit Beschriftung
von: Nepumuk
Geschrieben am: 01.09.2015 12:04:32
Hallo,
folgendes Makro nimmt dir die Arbeit ab:

Option Explicit

Public Sub Datenbeschriftung()
    
    Dim objSeries As Series, objPoint As Point
    Dim lngValueNumber As Long
    
    For Each objSeries In ThisWorkbook.Charts(1).SeriesCollection
        
        For Each objPoint In objSeries.Points
            
            With objPoint
                If .HasDataLabel Then .DataLabel.Delete
            End With
        Next
        
        With Tabelle2
            lngValueNumber = .Cells(objSeries.PlotOrder + 2, _
                .Columns.Count).End(xlToLeft).Column - 1
        End With
        
        With objSeries.Points(lngValueNumber)
            
            Call .ApplyDataLabels(Type:=xlDataLabelsShowValue)
            
            With .DataLabel
                .ShowValue = False
                .ShowSeriesName = True
            End With
        End With
    Next
End Sub

Gruß
Nepumuk

Bild

Betrifft: AW: Liniendiagramm mit Beschriftung
von: Nepumuk
Geschrieben am: 01.09.2015 12:15:50

Option Explicit

Public Sub Datenbeschriftung()
    
    Dim objSeries As Series, objPoint As Point
    Dim lngValueNumber As Long
    
    For Each objSeries In ThisWorkbook.Charts(1).SeriesCollection
        
        For Each objPoint In objSeries.Points
            
            With objPoint
                If .HasDataLabel Then .DataLabel.Delete
            End With
        Next
        
        With Tabelle2
            lngValueNumber = .Cells(objSeries.PlotOrder + 2, _
                .Columns.Count).End(xlToLeft).Column - 1
        End With
        
        With objSeries.Points(lngValueNumber)
            Call .ApplyDataLabels(ShowSeriesName:=True, ShowValue:=False)
        End With
    Next
End Sub


Bild

Betrifft: AW: Liniendiagramm mit Beschriftung
von: Beverly
Geschrieben am: 01.09.2015 13:05:55
Hi,
da für die Datenreihen der gesamte Zellbereich jeder Zeile ausgewählt ist, kann man die Datenpunkte vom letzten bis zum ersten in einer Schleife durchlaufen und prüfen, ob der Wert nicht leer ist - falls das der Fall ist, wird diesem Punkt die Datenbeschriftung hinzugefügt und dann die Schleife verlassen:

Sub Beschriftung()
    Dim serReihe As Series
    Dim lngPunkt As Long
    Dim lngReihe As Long
    Application.ScreenUpdating = False
    With Charts("Diagramm1")
        For lngReihe = 1 To .SeriesCollection.Count
            Set serReihe = .SeriesCollection(lngReihe)
            With serReihe
                .ApplyDataLabels
                .DataLabels.Delete
                For lngPunkt = serReihe.Points.Count To 1 Step -1
                    If .Values(lngPunkt) <> "" Then
                        .Points(lngPunkt).ApplyDataLabels
                        .Points(lngPunkt).DataLabel.ShowSeriesName = True
                        .Points(lngPunkt).DataLabel.ShowValue = False
                        Exit For
                    End If
                Next lngPunkt
            End With
        Next lngReihe
    End With
    Set serReihe = Nothing
    Application.ScreenUpdating = True
End Sub



Bild

Betrifft: AW: Liniendiagramm mit Beschriftung
von: Airwin Rooker
Geschrieben am: 02.09.2015 09:19:09
funkt Super danke!
Airwin

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Liniendiagramm mit Beschriftung"