Hallo liebe VBA-Kenner,
ich möchte ein Diagramm, welches ich in Excel in einer Userform darstellen lasse, per Button in eine neue PowerPoint-Präsentation exportieren.
Ich habe zwar einige Code-Beispiele im Netz gefunden, aber bisher noch keine Lösung für meinen Fall erstellen können.
Ich verwende Office 2003 (SP2) und arbeite unter Windows 2000 (SP4).
Anbei der Code, der zunächst eine Tabelle auswertet, um die Inhalte des Diagramms zu bestimmen und der Code in der Userform:
Public Sub diagrammwerte_schreiben()
Dim wert As Integer
With ThisWorkbook.Worksheets(1)
For a = 1 To 4
wert = 0
Select Case a
Case 1
wert = CInt(anzeigen(1).Caption)
.Cells(5, a) = CInt(anzeigen(12).Caption)
Case 2
wert = CInt(anzeigen(6).Caption)
.Cells(5, a) = CInt(anzeigen(17).Caption)
Case 3
c = 12
For b = 1 To 4
wert = wert + CInt(anzeigen(c).Caption)
c = c + 5
Next b
.Cells(5, a) = CInt(anzeigen(22).Caption)
Case 4
wert = CInt(anzeigen(33).Caption) + CInt(anzeigen(38).Caption)
.Cells(5, a) = CInt(anzeigen(27).Caption)
End Select
.Cells(3, a) = wert
Next a
.Cells(5, 5) = CInt(anzeigen(33).Caption)
.Cells(5, 6) = CInt(anzeigen(38).Caption)
.Cells(2, 1) = "DB Akademie"
.Cells(2, 2) = "DB Training"
.Cells(2, 3) = "Intern"
.Cells(2, 4) = "Extern"
.Cells(4, 1) = "Enrichment"
.Cells(4, 2) = "Enlargement"
.Cells(4, 3) = "Rotation"
.Cells(4, 4) = "Auslandseinsatz"
.Cells(4, 5) = "Coaching"
.Cells(4, 6) = "Training"
End With
End Sub
Private Sub UserForm_Activate()
Dim c As Object
Spreadsheet1.ActiveSheet.Cells.Clear
Worksheets("Tabelle1").Range("A2:D3").Copy
Spreadsheet1.ActiveSheet.Cells(1, 1).Paste
Application.CutCopyMode = False
ChartSpace1.Clear
ChartSpace1.Charts.Add
Set c = ChartSpace1.Constants
With ChartSpace1.Charts(0)
.Type = c.chChartTypePie
ChartSpace1.DataSource = Spreadsheet1
.SeriesCollection.Add
.HasLegend = True
With .SeriesCollection(0)
.SetData c.chDimSeriesNames, 0, "B1"
.SetData c.chDimCategories, 0, "A1:D1"
.SetData c.chDimValues, 0, "A2:D2"
.DataLabelsCollection.Add
.DataLabelsCollection(0).HasValue = False
.DataLabelsCollection(0).HasPercentage = True
.Points(0).Interior.Color = RGB(255, 255, 255)
.Points(1).Interior.Color = RGB(255, 0, 0)
.Points(2).Interior.Color = RGB(215, 222, 226)
.Points(3).Interior.Color = RGB(135, 140, 150)
End With
End With
End Sub
Ich hoffe, die Anhaltspunkte genügen, um mir bei meinem Problem zu helfen. Falls es noch Fragen dazu gibt, immer raus damit.
Gruß
Tobias |