Diagramm positionieren schlägt fehl
Ronny
nach nun einigen erfolgreichen Versuchen mit VBA eigene Makos zu erstellen stehe ich nun vor einem (für mich) größerem Problem.
Ich erzeuge mir per Makro ein Diagramm und lasse es, je nach Position bestimmter "Zeiger", im Arbeitsblatt positionieren.
Leider klappt es nicht wie beabsichtigt. Das neue Diagram wird immer um einen bestimmten absoluten Wert nach Unten verschoben und verursacht dann so im weiteren Verlauf Probleme...
Mein Kode sieht wie folgt aus:
****************************************************************************
Sub dia_erstellen()
Dim Ende As Integer
'Zeilenindex der letzten "Ende***************************
Ende = Cells.Find("Ende", [A1], , , xlByRows, xlPrevious, , True).Row
'Zeilenindex der Zelle ABegin + 6************************
Dim ZeigNam As Integer
ZeigNam = Cells.Find("ABegin", [A1], , , xlByRows, xlPrevious, , True).Row + 6
'Position nach Oben definieren********************************
Dim T As Integer
T = Cells(Ende - 2, 1).Top
'Position nach Links definieren*******************************
Dim L As Integer
L = Cells(Ende - 2, 1).Left
'*Objekt definieren und Arbeitsblatt "GLF" auswählen
Dim chDiagramm As ChartObject
Worksheets("GLF").Select
'*Objekt definieren******************************************
Set chDiagramm = Worksheets("GLF").ChartObjects.Add(L, T, 300, 140)
chDiagramm.Name = Cells(ZeigNam, 3).Value
With chDiagramm.Chart
.ChartType = xl3DPie
.SetSourceData Source:=Sheets("GLF").Range(Cells(Ende + 12, 14), Cells(Ende + 12, 19)), _
_
_
PlotBy:=xlColumns
.SeriesCollection(1).XValues = "={""gut"",""akzeptabel"",""schlecht""}"
.SeriesCollection(1).Values = "=(GLF!R" & Ende + 12 & "C14,GLF!R" & Ende + 12 & "C16, _
GLF!R" & Ende + 12 & "C18)"
.SeriesCollection(1).Name = "=GLF!R" & ZeigNam & "C3"
.Location Where:=xlLocationAsObject, Name:="GLF"
'*Datenwerte formatieren******************************
.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
.SeriesCollection(1).Points(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
.SeriesCollection(1).Points(3).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 38
.Pattern = xlSolid
End With
.ChartArea.Select
With Selection.Border
.Weight = 1
.LineStyle = 0
End With
'*Datenbeschriftung Prozentsätze einfügen***************
.SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
False, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
False, ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False
'*Titel formatieren*************************************
.HasTitle = True
.ChartTitle.Select
With Selection
.Characters.Text = "Wertanteile"
.Font.Bold = True
.Left = 5
.Top = -5
.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.Size = 11
End With
End With
'*Legende formatieren************************************
.HasLegend = True
.Legend.Select
With Selection
With Selection.Font
.Name = "Arial"
.Size = 10
End With
.Position = xlBottom
.Width = 265
.Height = 20
.Left = 32
End With
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
With Selection.Font
.Name = "Arial"
.Size = 10
End With
'*Zeichnungsfläche formatieren****************************
.PlotArea.Select
With Selection
.Top = 26
.Width = 190
.Height = 76
.Left = 50
.Interior.ColorIndex = xlNone
With Selection.Border
.Weight = xlThin
.LineStyle = xlNone
End With
End With
'*Datenbeschriftung Prozentsätze formatieren***************
.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 10
End With
'*Zeichnungsfläche in 3D Ansicht formatieren**************
.ChartArea.Select
With ActiveChart
.Elevation = 20
.Perspective = 30
.Rotation = 360
.RightAngleAxes = False
.HeightPercent = 60
End With
.ChartArea.Select
With ActiveChart
End With
End With
Set chDiagramm = Nothing
End Sub
******************************************************************************
Ich bitte die Unausgereiftheit dieses Makros zu entschuldigen. Bin relativ neu im Bereich VBA und wende mich heut das erste mal an Profi's. ;-)
Vielen Dank im Voraus!