Diagramme positionieren

Sub verteilung() Dim vorh As Boolean Dim n As Integer Application.DisplayAlerts = False For n = Sheets.Count To 1 Step -1 If Sheets(n).Name = "Verteilung" Or Sheets(n).Name Like "Dia*" Then Sheets(n).Delete Next n Application.DisplayAlerts = True Charts.Add ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Verteilung" Call vert("A50:G50,A52:G52", "Statusverteilung in %", 260, 300, 35, 600) 'Call vert("A50:G50,A51:G51", "Statusverteilung", 260, 300, 35, 240) 'Call vert("A45:E45,A47:E47", "Prioritätsverteilung in %", 255, 300, 324, 600) 'Call vert("A45:E45,A46:E46", "Prioritätsverteilung", 255, 300, 324, 240) End Sub Sub vert(rang As String, tex As String, h As Integer, w As Integer, t As Integer, l As Integer) Charts.Add With ActiveChart .Name = "dia" .ChartType = xlCylinderColClustered .SetSourceData Source:=Worksheets("Tabelle1").Range(rang), PlotBy:=xlColumns .Location Where:=xlLocationAsObject, Name:="Verteilung" .HasTitle = True '###################laufzeitfehler, Automatisierungsfehler .ChartTitle.Characters.Text = "Statusverteilung in %" .Axes(xlCategory).HasTitle = False .Axes(xlSeries).HasTitle = False .Axes(xlValue).HasTitle = False .HasAxis(xlCategory) = False .HasAxis(xlSeries) = False .HasAxis(xlValue) = True .Axes(xlCategory).CategoryType = xlAutomatic .HasDataTable = False End With With ActiveSheet .ChartObjects(dia).Height = h .ChartObjects(dia).Width = w .ChartObjects(dia).Top = t .ChartObjects(dia).Left = l End With End Sub Sub Makro12() With ActiveChart .HasTitle = True .ChartTitle.Characters.Text = "test" End With ActiveChart.ChartArea.Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub vert(rang As String, tex As String, h As Integer, w As Integer, t As Integer, l As Integer) Charts.Add With ActiveChart .Name = "dia" .ChartType = xlCylinderColClustered .SetSourceData Source:=Worksheets("Tabelle1").Range(rang), PlotBy:=xlColumns .Location Where:=xlLocationAsObject, Name:="Verteilung" .HasTitle = True '###################laufzeitfehler, Automatisierungsfehler .ChartTitle.Characters.Text = "Statusverteilung in %" .Axes(xlCategory).HasTitle = False .Axes(xlSeries).HasTitle = False .Axes(xlValue).HasTitle = False .HasAxis(xlCategory) = False .HasAxis(xlSeries) = False .HasAxis(xlValue) = True .Axes(xlCategory).CategoryType = xlAutomatic .HasDataTable = False End With With ActiveSheet .ChartObjects(dia).Height = h .ChartObjects(dia).Width = w .ChartObjects(dia).Top = t .ChartObjects(dia).Left = l End With End Sub

Sub MehrereDiagramme() Dim vorh As Boolean Dim n As Integer Dim anz As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False For n = Sheets.Count To 1 Step -1 If Sheets(n).Name = "testdia" Or Sheets(n).Name Like "Dia*" Then Sheets(n).Delete Next n Application.DisplayAlerts = True Charts.Add ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range("A65536") ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="testdia" Call DiaErzeugen("testdia", "A1:B12", "Dia1", xlColumnClustered, 200, 300, 0, 0) Call DiaErzeugen("testdia", "A1:B12", "Dia2", xlCylinderColClustered, 200, 300, 300, 0) Call DiaErzeugen("testdia", "A1:B12", "Dia3", xlBarStacked, 200, 300, 0, 300) Call DiaErzeugen("testdia", "A1:B12", "Dia4", xl3DPie, 200, 300, 300, 300) Application.ScreenUpdating = True End Sub

Sub DiaErzeugen(Blattname As String, Bereich As String, DiaTitel As String, _ DiaTyp As String, Höhe As Integer, Breite As Integer, Oben As Integer, Links As Integer) 'Application.ScreenUpdating = False Charts.Add With ActiveChart .ChartType = DiaTyp .SetSourceData Source:=Sheets("Tabelle1").Range(Bereich), PlotBy:=xlColumns .Location Where:=xlLocationAsObject, Name:=Blattname End With With ActiveChart .HasTitle = True .ChartTitle.Characters.Text = DiaTitel .Axes(xlCategory, xlPrimary).HasTitle = False .Axes(xlValue, xlPrimary).HasTitle = False End With anz = ActiveSheet.Shapes.Count With ActiveSheet.Shapes(anz) .Height = Höhe .Width = Breite .Top = Oben .Left = Links End With 'Application.ScreenUpdating = True End Sub

Hallo,
mit "im falschen Blatt" meine ich, dass die einzelnen Charts im Tabellenblatt
erzeugt werden müssen und nach Fertigstellung in das Chartsheet übertragen werden.
Da in einem Tabellenblatt das Objekt Chart das Diagramm ist, in einem Chartsheet
das Objekt Chart aber das Chartsheet selbst ist, kommt es bei deiner Variante zu
Konflikten. Wie schon geschrieben, Objektvariable verwenden, dann kann das nicht
passieren.

''Erstellt am: 26.09.2004
''Autor:       K.Rola
''Die Verwendung von Konstanten ist bei umfangreicherem Code deutlich langsamer
''als die Verwendung der entsprechenden Long-Werte. Bei Codes mit Late-Binding,
''also, wenn kein Verweis auf eine entsprechende Bibliothek gesetzt ist, können
''die Konstanten ohnehin nicht verwendet werden, z.B. bei VBS oder wenn Excel
''extern gesteuert wird.
''xlLocationAsNewSheet = 1
''xlLocationAsObject = 2
''xlColumnClustered = 51
''xlCylinderColClustered = 92
''xlBarStacked = 58
''xl3DPie = -4102
Option Explicit
''Name für das ChartSheet
Const BNAME As String = "4Charts"
''Namen für die Diagramme
Const DIA1$ = "KRola"
Const DIA2$ = "LVira"
Const DIA3$ = "Rubdi"
Const DIA4$ = "Rabdu"
Dim ShAktiv As String
Sub makeChartSheet()
Dim Sh As Object, Ch1 As Chart
ShAktiv = ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
''Falls ChartSheet vorhanden ist, löschen.
If BTest Then Sh.Delete
Application.DisplayAlerts = True
Set Ch1 = Charts.Add
Ch1.Location 1, BNAME
''Die Diagrammtitel stehen in D2:D5 der Quelltabelle(ShAktiv).
Call makeCh(DIA1, BNAME, "A1:B10", "R2C4", 51, 220, 320, 0, 0)
Call makeCh(DIA2, BNAME, "A1:B10", "R3C4", 92, 220, 320, 225, 0)
Call makeCh(DIA3, BNAME, "A1:B10", "R4C4", 58, 220, 320, 0, 325)
'Kreisdiagramm können nur eine Datenreihe haben!
Call makeCh(DIA4, BNAME, "A1:A10", "R5C4", -4102, 220, 320, 225, 325)
'Falls kein Wechsel auf das Diagrammblatt gewünscht ist.
'Sheets(ShAktiv).Activate
Application.ScreenUpdating = True
End Sub
Sub makeCh(ChName$, ShName$, Quelle$, ChTitel$, ChTyp&, h#, w#, t#, L#)
'Der Diagrammtyp ist vom Datentyp Long(&)
'Width, Height, Top und Left sind bei Diagrammen vom Datentyp Double(#)
Dim Ch As Chart
Set Ch = Charts.Add
Set Ch = Ch.Location(2, ShName)
With Ch
.ChartType = ChTyp
.SetSourceData Sheets(ShAktiv).Range(Quelle), xlColumns
.HasTitle = True
'Bei .ChartTitle.Characters.Text ist keine Formel möglich!!!
'Die Formel muss in Bezugsart R1C1 sein!
'Die Diagrammtitel stehen in D2:D5 der Quelltabelle(ShAktiv)
.ChartTitle.Text = "=" & ShAktiv & "!" & ChTitel
With .Parent
'Für spätere Bearbeitung ist es günstig, gleich einen Namen zu geben.
.Name = ChName
.Height = h
.Width = w
.Top = t
.Left = L
End With
.Location 2, ShName
.SizeWithWindow = True
.Deselect 'Fokus vom Diagramm nehmen
End With
End Sub
Sub Namen_testen()
Dim c As Byte
If Not BTest Then Exit Sub
With Sheets(BNAME)
For c = 1 To .ChartObjects.Count
MsgBox .ChartObjects(c).Name
Next
End With
End Sub
Sub Chart1_aendern()
Dim Ch As Chart
If Not BTest Then Exit Sub
Set Ch = Sheets(BNAME).ChartObjects(DIA1).Chart
If Ch.ChartType = xlLine Then
Ch.ChartType = xlColumnClustered
Else
Ch.ChartType = xlLine
End If
End Sub
Private Function BTest() As Boolean
Dim Sh As Object
For Each Sh In Sheets
If Sh.Name = BNAME Then BTest = True
Next
End Function

Gruß K.Rola

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread