Option Explicit
Public Sub CopyLegend2Textbox()
Dim strLabel As String ' String eines Legendeneintrags
Dim iEintrag As Integer ' Nummer des Legendeneintrags
Dim iTexthoehe As Integer ' Abstand der erzeugten Labels
Dim iZeichen As Integer ' Laufvariable für einen String
iTexthoehe = 20
With ActiveChart
On Error Resume Next ' Fehlerbehandlung ignorieren
If .Name = "" Then Exit Sub ' Prozedur verlassen, wenn kein Diagramm ausgewählt wurde
For iEintrag = 1 To .Legend.LegendEntries.Count
strLabel = .SeriesCollection(iEintrag).Name ' Beschriftung des Legendeneintrags auslesen
.SeriesCollection(iEintrag).Name = "" ' Beschriftung des Legendeneintrags löschen
' neue Textbox hinzufügen
.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100 + iEintrag * iTexthoehe, 100, iTexthoehe).TextFrame.Characters.Text = strLabel
With .Shapes.Item(ActiveChart.Shapes.Count).TextFrame
For iZeichen = 1 To .Characters.Count ' alle Zeichen durchlaufen
If IsNumeric(.Characters(iZeichen, 1).Text) Then
' wenn das aktuell eingelesene Zeichen numerisch ist,
' dann soll es tiefgestellt werden
' (Ladungs- und Isotopenzahlen dürfen daher nicht auftreten)
.Characters(iZeichen, 1).Font.Subscript = True
End If
Next iZeichen
End With
Next iEintrag
End With
End Sub
