Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Recordercode: Select ausbauen

Recordercode: Select ausbauen
25.02.2023 11:21:25
Michael
Hallo zusammen,
mit diesem Code richte ich die Wertebeschriftungen zweier Linien in einem Liniendiagramm aus. Klappt wie gewünscht. Aber wie werde ich das Select in der Schleife los? Mein Versuch jeweils auskommentiert darüber, aber ein DataLabel scheint selber leider keine SetElement-Methode zu haben.
Anhand der API erkenne ich nicht, wie`s gehen soll und Google findet mir nur, wie Diagrammtitel oder Achsenbeschriftungen anders ausgerichtet werden....
Sähe man die Beschriftungen im Diagramm wenigstens einzeln auf ihren neuen Platz hüpfen, wäre es ja noch ganz witzig, aber so scheint mir das nur unnötig lange zu dauern.
Sub LiniendiagrammbeschriftungAusrichten()
    
    Dim i As Integer
    Dim arrPunkteLinieEins
    Dim arrPunkteLinieZwei
    
    With ActiveChart
    
        arrPunkteLinieEins = .SeriesCollection(1).Values
        arrPunkteLinieZwei = .SeriesCollection(2).Values
        
        For i = 1 To UBound(arrPunkteLinieEins) '.SeriesCollection(1).Points.Count
          
            If arrPunkteLinieEins(i)  arrPunkteLinieZwei(i) Then
                '.SeriesCollection(1).Points(i).DataLabel.SetElement (msoElementDataLabelBottom)
                '.SeriesCollection(2).Points(i).DataLabel.SetElement (msoElementDataLabelTop)
                .SeriesCollection(1).Points(i).DataLabel.Select
                .SetElement (msoElementDataLabelBottom)
                .SeriesCollection(2).Points(i).DataLabel.Select
                .SetElement (msoElementDataLabelTop)
            Else
                '.SeriesCollection(2).Points(i).DataLabel.SetElement (msoElementDataLabelBottom)
                '.SeriesCollection(1).Points(i).DataLabel.SetElement (msoElementDataLabelTop)
                .SeriesCollection(2).Points(i).DataLabel.Select
                .SetElement (msoElementDataLabelBottom)
                .SeriesCollection(1).Points(i).DataLabel.Select
                .SetElement (msoElementDataLabelTop)
            End If
        Next i
    End With
End Sub

Ganz lieben Dank im Voraus,
Schönes Wochenende
Michael

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Recordercode: Select ausbauen
25.02.2023 12:07:31
Beverly
Hi Michael,
z.B. so:
Sub LiniendiagrammbeschriftungAusrichten()
    Dim i As Integer
    Dim arrPunkteLinieEins
    Dim arrPunkteLinieZwei
    With ActiveSheet.ChartObjects(1).Chart
        arrPunkteLinieEins = .SeriesCollection(1).Values
        arrPunkteLinieZwei = .SeriesCollection(2).Values
        For i = 1 To UBound(arrPunkteLinieEins) '.SeriesCollection(1).Points.Count
            If arrPunkteLinieEins(i)  arrPunkteLinieZwei(i) Then
                .SeriesCollection(1).Points(i).DataLabel.Position = xlLabelPositionBelow
                .SeriesCollection(2).Points(i).DataLabel.Position = xlLabelPositionAbove
            Else
                .SeriesCollection(2).Points(i).DataLabel.Position = xlLabelPositionBelow
                .SeriesCollection(1).Points(i).DataLabel.Position = xlLabelPositionAbove
            End If
        Next i
    End With
End Sub
Bis später
Karin

Anzeige
AW: Recordercode: Select ausbauen
25.02.2023 18:37:04
Michael
Hallo Karin,
vielen Dank, funktioniert super! So hatte ich mir das vorgestellt.
In der API habe ich's jetzt auch endlich gefunden.
Viele Grüße
Michael

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige