VBA-Problem bei Diagrammerstellung und -anpassung
20.02.2014 18:52:40
n8liner
Mit Excel VBA habe ich ein "kleines" Problem. Per Makro will ich ein Kreisdiagramm in einer Zelle erstellen und automatisch an die Größe der Zelle anpassen. Nun das Problem:
Wenn ich das Makro im Debug-Modus in Einzelschritten durchlaufe, wird dass Diagramm richtig gezeichnet und positioniert.
Starte ich das Makro normal, so werden die Größen und die Position nicht angepasst.
Was läuft da schief?
Hier das Makro:
Sub Tortendiagramm()
' Tortendiagramm erstellen
Dim breite As Double 'breite der Zielzelle (in points )
Dim hoehe As Double 'höhe der Zielzelle (in points)
Dim pos_links As Double 'Zellposition Zielzelle links (in Points) - basis ist zelle 1, _
spalte 1
Dim pos_oben As Double 'Zellpostion Zielzelle oben (in points ) - basis ist zelle 1, _
spalte 1
Dim chartname 'Chartname
Dim co As ChartObject ' für Chart-Bearbeitung benötigt
Dim wertbereich As String 'Bereich, der Diagrammwerte enthält
Dim ziel_sp As Integer 'spaltennr. der Zeller, in der das diagramm erstellt werden _
soll
Dim ziel_zl As Integer 'Zeilennr. der Zelle, in der das diagramm erstellt werden soll
Dim xl_version As Integer 'excel-Version
ziel_sp = 3 'Zielspalte für das Diagramm
ziel_zl = 3 'Zielzeile für das Diagramm
xl_version = 2013
wertbereich = "B1:B2" 'Werte für Kreisdiagramm
If Application.ActiveSheet.ChartObjects.Count > 0 Then Application.ActiveSheet.ChartObjects. _
Delete
' Zellgröße und Zell-Position bestimmen (Pixel)
pos_links = Cells(ziel_zl, ziel_sp).Left + 1
pos_oben = Cells(ziel_zl, ziel_sp).Top + 1
breite = Cells(ziel_zl, ziel_sp).Width - 2
hoehe = Cells(ziel_zl, ziel_sp).Height - 2
'Tortendiagramm erstellen (Befehle abhängig von Excel-Version; Annahme 2010 oder 2013
If xl_version = 2013 Then
ActiveSheet.Shapes.AddChart2(251, xlPie, pos_links, pos_oben, breite, hoehe).Select
Else 'wenn nicht 2013 dann 2010 oder 2007
ActiveSheet.Shapes.AddChart2(xlPie, pos_links, pos_oben, breite, hoehe).Select
End If
ActiveChart.SetSourceData Source:=Range(wertbereich)
'Namen des Charts
chartname = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 2)
'shape ohne Rahmen
ActiveSheet.Shapes(chartname).Line.Visible = msoFalse
' neues Diagram aktivieren
ActiveSheet.ChartObjects(chartname).Activate
'Chart ohne Legende und Titel
With ActiveChart
If .HasTitle Then .ChartTitle.Delete
If .HasLegend Then .Legend.Delete
End With
'Diagramm auf max. mögliche Zell-Größe und in der Zelle zentrieren
With ActiveChart.PlotArea
.Top = -10
.Height = hoehe - 4
.Width = hoehe - 4
.Left = (.Parent.ChartArea.Width - .Width) / 2
.Top = (.Height - hoehe + 0.5) / 2
End With
ende:
' Diagrammnamen in Zelle eintragen
Cells(ziel_zl + 2, ziel_sp).Value = chartname
End Sub