AW: Grafiken mit Makro erstellen
15.07.2006 12:45:27
fcs
Hallo Frank,
hier mein Vorschlag, wie man die Diagramme generieren kann. Namen der Tabelle und des Diagramm-Musters, Formeln für Registername und Diagramm-Titel, sowie ggf. einige Diagramm-Einstellungen muss du noch anpassen.
Gruß
Franz
Sub DiagrammeGenerieren()
' Generiert pro Datenzeile in der Tabelle ein Diagramm
Dim wks As Worksheet, rngNamen As Range, rngIndex As Range, strMusterDiagramm As String
Dim AnzSpalten As Integer, ZeileL As Long, i As Long, rngDaten As Range
Dim Diagramm As Chart
Set wks = ActiveWorkbook.Sheets("Tab1") 'Tabelle mit den Daten für die Diagramme
strMusterDiagramm = "Test Schwarz Rot Gold" 'Name des benutzerdefinierten Musterdiagramms
With wks
AnzSpalten = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Letzte Spalte mit Name
ZeileL = .Cells(.Rows.Count, "A").End(xlUp).Row 'LetzteZeile mit Indexdaten
Set rngNamen = .Range(.Cells(1, 1), .Cells(1, AnzSpalten)) 'Bereich mit Daten in Zeile 1
End With
Application.ScreenUpdating = False
For i = 2 To ZeileL
If wks.Cells(i, 1).Value <> "" Then 'Zeile enthält Daten eines Indexes
Set rngIndex = wks.Range(wks.Cells(i, 1), wks.Cells(i, AnzSpalten)) 'Bereich mit Indexdaten
Set rngDaten = Application.Union(rngNamen, rngIndex) 'Datenbereich für Diagramm
Charts.Add
Set Diagramm = ActiveChart
With Diagramm
.SetSourceData Source:=rngDaten, PlotBy:=xlRows
.ApplyCustomType ChartType:=xlUserDefined, TypeName:=strMusterDiagramm
.Location Where:=xlLocationAsNewSheet, Name:=rngIndex(1, 1) 'Index als Registername
.Move After:=Sheets(Sheets.Count)
' Diagrammtitel Festlegen
.HasTitle = True
.ChartTitle.Characters.Text = "Index: " & rngIndex(1, 1)
' ggf. weitere vom Muster abweichende Eigenschaften festlegen
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
.HasLegend = False
End With
End If
Next i
wks.Select
Application.ScreenUpdating = True
End Sub