Meine Prozedur (Ergänzung)
22.07.2004 17:06:57
Tobias
Hallo nochmal!
Wie von Ulf erbeten, hier meine Prozedur. Es sind noch keine Erläuterungen drin und der Stil ist vermutlich auch nicht perfekt. Immerhin tut es aber was es soll, abgesehen vom eigentlichen Erstellen der Diagramme.
Vorweg nochmal zur Erklärung. In einem Arbeitsblatt befinden sich mehrere Tabellen, auf die die Prozedur automatisch zugreift. Die Namen der Tabellen sind in der Spalte A hinterlegt. Die Prozedur speichert diese Namen nun der Reihe nach in der Variable strTabelle und springt entsprechend auf dem Arbeitsblatt zu den einzelnen Tabellen.
In diesen bestimmt die Prozedur nun zunächst Breite und Höhe der Tabelle und markiert danach einzelne Spalten. Das Kriterium für die Markierung ist ein im Arbeitsplatt über die entsprechende Spalte gesetztes "x". So kann der Benutzer festlegen, welche Spalten später Teil des Diagramms werden sollen und welche nicht. Meine Vorgabe für die Prozedur war die, dass eine beliebige Anzahl Tabellen mit beliebig vielen Spalten und Zeilen auf demselben Arbeitsplatt mit immer derselben Prozedur verarbeitet werden kann.
(die Tabellen beginnen alle in Zeile 8, darum wird intTabelle_n zu Anfang auf 8 gesetzt)
Sub diagramm_zeichnen()
Dim strTabelle As String 'Namensvariable zum Abruf der per Namensfeld benannten Tabellen
Dim intTabelle_n As Integer 'Zählervariable - Anzahl der zu übertragenden Tabellen
Dim intSpalte As Integer 'Zählervariable - Tabellenspalten
Dim intZeile As Integer 'Zählervariable - Tabellenzeilen
Dim intI As Integer 'allgemeine Zählervariable
Dim intZaehler As Integer 'definiert das Maximum der Zählervariable intI
Dim dblEnde_Zeile As Double
Dim aBereich(6) As Variant
Dim test As Variant
intTabelle_n = 8
Do While intTabelle_n <> 0
strTabelle = Range("A" & intTabelle_n).Value
intI = 1
intZeile = 4
If strTabelle = "" Then
intTabelle_n = 0
Exit Do
Else: intTabelle_n = intTabelle_n + 1
End If
intSpalte = Range(strTabelle).Column
intZaehler = Cells(Rows.Count, intSpalte - 1).End(xlUp).Row - 6
For intI = 1 To intZaehler
If Cells(intZeile, intSpalte).Value = "x" Then
dblEnde_Zeile = Cells(Rows.Count, intSpalte).End(xlUp).Row
Range(Cells(intZeile + 3, intSpalte), Cells(dblEnde_Zeile, intSpalte)).Select
aBereich(intI - 1) = Selection.Address
intSpalte = intSpalte + 1
test = intI - 1
ElseIf Cells(intZeile, intSpalte).Value = 0 Then
intSpalte = intSpalte + 1
End If
Next
Loop
Ab hier ist alles bislang Improvisation. An dieser Stelle kann das Erstellen der Diagramme natürlich nicht stehen bleiben, doch wenn man versucht nur eine einzelne Tabelle in ein Diagramm zu verarbeiten funktioniert es. Und mir geht es ja zunächst einmal um die Funktion an sich.
Ich möchte die X-Achse der Diagramme mit der ersten Spalte der Tabellen füllen. In dieser ersten Spalte stehen immer Jahreszahlen. Das bedeutet, ich muss irgendwie einen relativen, variablen Bezug auf die erste Spalte der Tabellen herstellen. Und genau daran hakts im Moment.
Setzt man den Wert von ActiveChart.SeriesCollection(1) gleich denen von SeriesCollection 2 und 3, funktioniert es. Dann habe ich die Jahresangaben in der Tabelle als X Werte des Diagramms. Aber eben nur deswegen, weil ein fester Bezug auf die erste Spalte der ersten Tabelle des Arbeitsblattes besteht. Darum die ? hinter SeriesCollection(1).
Charts.Add
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Sheets("Energie_Strom").Range(aBereich(0), aBereich(test)), PlotBy:=xlColumns
'ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).XValues = "=Energie_Strom!" + ?
'ActiveChart.SeriesCollection(2).XValues = "=Energie_Strom!R8C3:R12C3"
'ActiveChart.SeriesCollection(3).XValues = "=Energie_Strom!R8C3:R12C3"
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.position = xlTop
Sheets("Energie_Strom").Select
End Sub
Das alles ist viel komplizierter zu erklären als es eigentlich ist. Ich hoffe irgendwer konnte mir folgen. Falls nicht, könnte ich höchstens noch die gesamte Arbeitsmappe inklusive der Arbeitsblätter hier reinstellen.
besten Dank soweit
Tobias