Kreisdiagramm: Beschriftung positionieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Bernd,
habe ich gerade versucht, klappt leider nicht. Die Datei (c:\Muster.xls) ruft den Fehler "ungültiger Dateiname" hervor. Wahrscheinlich ist sie mit fast 600kb aber auch einfach zu groß.
Habe daher ein Beispiel mit einem Kreisdiagramm hochgeladen.
https://www.herber.de/bbs/user/44941.xls
Das Programm, dass ich bastel, sieht im endeffekt so aus:
1. Eine Musterdatei enthalt ein Kreisdiagramm (und sonstigen Kram, der hier allerdings nicht so wichtig ist)
2. In der Hauptarbeitsmappe wird ermittelt, wie viele Kreisdiagramme benötigt werden
3. In der Musterdatei wird das Kreisdiagramm dementsprechend oft untereinander kopiert (Zeilen von 1 bis 40 werden kopiert und in Zeile 41,81,121 usw. eingefügt)
4. In der Musterdatei wird jedem Kreisdiagramm der Bereich für dessen Quelldaten zugeordnet
5. Aus einer dritten Datei werden die benötigten Quelldaten in den Bereich jedes einzelnen Diagrammes kopiert
In folgendem Makro sind die Schritte 2 bis 4 dargestellt. Da ich eh jedes Diagramm aktiviere, wäre es praktisch, wenn es eine Möglichkeit geben würde, durch eine Anweisung die Beschriftungen zu so verteilen, dass sie nicht übereinanderstehen. Ich hoffe meine Beispieldatei hilft da ein bisschen weiter. Eigentlich sollte es ja kein Unterschied sein, ob man es für ein oder max. 282 Diagramme macht.
Hier der Code für das Vorbereiten der Musterdatei (wird aus der Hauptdatei ausgeführt):


Sub Muster_vorbereiten()
Dim bereich As Range
Dim Zeilen As Integer
Dim dateiname As Variant
Dim durchlauf As Long
Dim diagramm As ChartObject
Dim DAnfang As Long
Dim DEnde As Long
Application.ScreenUpdating = False
durchlauf = 1
dateiname = ThisWorkbook.Name
Windows(dateiname).Activate
Set bereich = Sheets(3).Columns(1)
'Zähl der benötigten Musterseiten ermitteln
Zeilen = Application.WorksheetFunction.CountIf(bereich, "KP*") _
+ Application.WorksheetFunction.CountIf(bereich, "UP*")
'Kopieren der benötigten Musterseiten
For i = 1 To Zeilen - 1
On Error GoTo ende
Windows("Muster.xls").Activate
Cells(durchlauf, 1).Select
ActiveCell.Range("a1:i40").Select
Selection.Copy
Cells(durchlauf + 40, 1).Select
ActiveSheet.Paste
durchlauf = durchlauf + 40
Next i
On Error GoTo ende
Windows("Muster.xls").Activate
z = 1
For Each diagramm In ActiveSheet.ChartObjects
diagramm.Name = "Diagramm " & z
z = z + 1
Next
DAnfang = 34
DEnde = 37
'Datenbereich der Diagramme bestimmen
For n = 1 To Zeilen
Range("a1").Select
ActiveSheet.ChartObjects("Diagramm " & n).Activate
ActiveChart.ChartArea.Select
ActiveChart.SetSourceData Source:=Sheets("Präsentation A").Range("D" & DAnfang & ":e" &  _
DEnde), _
PlotBy:=xlColumns
DAnfang = DAnfang + 40
DEnde = DEnde + 40
Next n
Range("a1").Select
Windows(dateiname).Activate
ende:
Application.ScreenUpdating = True
End Sub

Sub Beschriftung() ActiveSheet.ChartObjects("Diagramm 3").Activate ActiveChart.SeriesCollection(1).DataLabels.Select ActiveChart.SeriesCollection(1).Points(1).DataLabel.Select Selection.Left = 75 Selection.Top = 20 ActiveChart.SeriesCollection(1).Points(4).DataLabel.Select Selection.Left = 81 Selection.Top = 156 End Sub

Beliebteste Forumthreads (12 Monate)

Kreisdiagramm: Beschriftung positionieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kreisdiagramm: Beschriftung positionieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread