AW: in Diagramm Pfeile einfügen per VBA
17.12.2006 20:37:09
ingUR
Hallo, Herby,
neben der von Franz vorgestellten Möglichkeit, kannst Du auch in Deinem Fall den Excel4Marco-Aufruf
ExecuteExcel4Macro(xy, 2, DatenPunktSerie)
benutzen, um die Koordiniaten eines Datenpunktes zu ermitteln.
xy = 1 oder 2 ist dabei danach zu setzen, ob die x Ordinate (xy=1) oder die y Ordinate (xy=2) ermittelt werden soll.
Der Wert 2 steht in diesem Fall gleichberechtig neben den Werten 1 bis 8, wo es um einen Punkt geht. Für Säulen sind hier die entsprechenden Marken (Ecken/Mittelpunkte der Seiten von 1 bis 8 numeriert) anzugeben, die als Bezugspunkt für den zu ermitteden Koordinaten gelten sollen.
Die Angabe des Datenpunktes aus einer Serie ist als Textwert in der Form SjPi mit j für die Seriennummer in Chart und i der Punktnummer. Der Text 1,2,"S1P3" als Parameter in der Funktion GET.CHAT.ITEM, fordert also die x-Koordinate des dritten Datenpunktes in der Datenreihe 1 an (bei Säulendiagramme wäre es die Mitte der oberen Säulenrechteckseite).
Hier ein Grundgerüst, da mir momentan die Zeit fehlt, die ungereimtheiten im Code auszumerzen. Es wäre schön, wenn Du, so der Weg Deinen Vorstellungen entspricht, die erforderlichen Richtigstellungen und Erweiterungen vornehmen könntest und das Ergebnis veröffentlichst.
Option Explicit
Sub DrawArrows()
Dim ws As Worksheet, chtChart As Chart
Dim rngAllPXY As Range, rngPXY As Range
Dim dX0 As Double, dY0 As Double, dX1 As Double, dY1 As Double
Dim p As Integer, strP As String, strPX As String, strPY As String
Set rngAllPXY = Range("A2:A16")
Set ws = Worksheets("Tabelle1")
ws.ChartObjects(1).Activate
Set chtChart = ws.ChartObjects(1).Chart
With chtChart
For Each rngPXY In rngAllPXY
dX0 = dX1
dY0 = dY1
p = p + 1
strPX = "GET.CHART.ITEM(1,1," & Chr(34) & "S1P" & p & Chr(34) & ")"
strPY = "GET.CHART.ITEM(2,1," & Chr(34) & "S1P" & p & Chr(34) & ")"
dX1 = ExecuteExcel4Macro(strPX)
dY1 = ExecuteExcel4Macro(strPY)
'Kontrollausgabe der gelesenen X1/Y1-Werte (XLM-Koordinaten)
'Startpunkt des Peiles
ws.Cells(20 + p, 1) = dX1
ws.Cells(20 + p, 2) = (.ChartArea.Height) - dY1
If p > 1 Then
'Kontrollausgabe der Differenzen (Pfeil.H.Weite und Pfeil.V.Höhe)
ws.Cells(20 + p, 3) = dX1 - dX0
ws.Cells(20 + p, 4) = dY0 - dY1
.Shapes.AddShape msoShapeRightArrow, dX0, (.ChartArea.Height) - dY0, dX1 - dX0, dY0 - dY1
'"Formatierungs"-Anweisungen für den Pfeil
End If
Next
End With
Range("A1").Select
Set rngAllPXY = Nothing
Set ws = Nothing
End Sub
Ich hoffe dass Du eine vollständige Lösung findest, denn das Ergebnis interessiert mich für eigene Anwendungen.
Gruß,
Uwe