Diagramme ändern ohne select

Sub Name_Trigrams_A1() 'Makro bestimmt den mittlerenRing der äußeren Ringgruppe 'Es schreibt die Elementnamen und -zeichen entsprechend früh- und späthimmlisch. 'Es färbt die 8 Trigrammnamen und Zeichen entsprechend ihrer Elementfarben 'Auf dem Blatt "Tabellen" wird zwischen späten und frühem Himmel vorbereitet. Dim intTrigramCol(40) As String 'Farbe des Trigramms Dim strTrigramName(40) As String 'Name des Trigramms Dim i As Integer 'Zähler Dim intLine As Integer 'Zeilennummer auf dem Blatt "Tabellen" Dim objDaten As Object 'Blatt Tabellen Set objDaten = Sheet27 intLine = 146 For i = 1 To 40 'vorbereitete Daten einlesen strTrigramName(i) = objDaten.Range("ES" & intLine) intTrigramCol(i) = objDaten.Range("ET" & intLine) intLine = intLine + 1 Next i Sheet29.Activate Application.ScreenUpdating = False ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.SeriesCollection(3).Select For i = 1 To 40 'eingelesene Daten übergeben ActiveChart.SeriesCollection(3).Points(i).DataLabel.Select Selection.Characters.Text = strTrigramName(i) Selection.Font.ColorIndex = intTrigramCol(i) Next i Range("cn95").Activate 'Diagramm wieder verlassen Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Gerd,

das ist phantastisch!!!! Es funktioniert ohne selektieren, ja man muß noch nicht einmal auf dem Blatt sein. Meine Frage ist nun: Könnte man da nicht weiter gehen und zum Beispel für SeriesCollections oder DataLabel ein Object bilden? Meine Versuch schlugen jedoch bisher fehl.

Hier der neue Code:


Sub Name_Trigrams_A1()
Dim intTrigramCol(40) As String    'Farbe des Trigramms
Dim strTrigramName(40) As String   'Name des Trigramms
Dim i As Integer                   'Zähler
Dim intLine As Integer             'Zeilennummer auf dem Tabellenblatt
Dim objDaten As Object             'Blatt Tabellen
Dim chtTrigram As Chart            'Objekt des Diagramms
Set objDaten = Sheet27
Set chtTrigram = Sheet29.ChartObjects("Chart 1").Chart
intLine = 146
For i = 1 To 40
strTrigramName(i) = objDaten.Range("ES" & intLine)
intTrigramCol(i) = objDaten.Range("ET" & intLine)
intLine = intLine + 1
Next i
For i = 1 To 40
With chtTrigram
With .SeriesCollection(3).Points(i)
.DataLabel.Characters.Text = strTrigramName(i)
.DataLabel.Font.ColorIndex = intTrigramCol(i)
End With
End With
Next i
End Sub

Habe gleich weiter probiert, um den Code weiter zu kürzen. Die Frage ist, ob der dadurch schneller wird - funktionieren tut er!

Neuer Code 2. Variante:


Sub Name_Trigrams_A1()
Dim i As Integer                'Zähler
Dim intLine As Integer          'Zeilennummer auf dem Tabellenblatt
Dim objDaten As Object          'Blatt "Tabellen"
Dim chtTrigram As Chart
Set objDaten = Sheet27
Set chtTrigram = Sheet29.ChartObjects("Chart 1").Chart
intLine = 146
For i = 1 To 40
With chtTrigram
With .SeriesCollection(3).Points(i)
.DataLabel.Characters.Text = objDaten.Range("ES" & intLine) 'Name des Trigramms
.DataLabel.Font.ColorIndex = objDaten.Range("ET" & intLine) 'Farbe des Trigramms
End With
End With
intLine = intLine + 1
Next i
End Sub

Ich bin begeistert. Vielen Dank für den Hinweis.

Michael

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread