PDA

Vollständige Version anzeigen : Donuts automatisch verbinden


robinho
19.01.2005, 14:20
ich erzeuge mir automatisch Donuts (Kreismarkierungen) an Positionen, abhängig von eingehenden Daten.
Diese möchte ich auch automatisch durch eine Linie verbinden.
Hier Quellcodeauszug, von dem wie ich bisher dachte dat es funzen könnte:

For i = 1 To 11
hold_ = left_
left_ = (wert(i) * 141) + (wert(i) - 3) * 1.5
'Angaben für (Type, Left, Top, Width, Height)
ActiveSheet.Shapes.AddShape(msoShapeDonut, left_, top_, 30, 30#).Select

Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 'ROT
Selection.ShapeRange.Fill.Transparency = 0#
If i >= 9 Then top_ = top_ - 17
top_ = top_ + 64.7

If i >= 2 Then
Set firstDonut = s.Shape(msoShapeDonut, left_, top_, 30, 30)
Set secondDonut = s.AddShape(msoShapeDonut, left_ * 2, top_, 30, 30)
Set c = s.AddConnector(msoConnectorStraight, 0, 0, 0, 0)
With c.ConnectorFormat
.BeginConnect ConnectedShape:=firstDonut_, ConnectionSite:=1
.EndConnect ConnectedShape:=secondDonut, ConnectionSite:=1
c.RerouteConnections
End With
End If
Next i

Hat jeman eine IDEEEEEE?
Danke :cool:

robinho
19.01.2005, 16:10
HIER IST DIE MEINIGE LÖSUNG
DANKE FÜR NICHTS

Sub setDonuts()

Dim qa, qe, mb, mm, sb, sk, pk, pr, vh, vd, vr As Single
Dim top_, left_, hold_ As Single
Dim donuts As Variant
Dim wert As Variant
wert = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11) 'Werte als Platzhalter; erste Pos. wird nicht belegt
donuts = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)

'sinnloses Shape-Obj. erzeugen, denn
'ist kein Shape-Obj. vorhanden verschiebt er irgendwelche Zeilen
ActiveSheet.Shapes.AddShape(msoShapeDonut, 20, 20, 20, 20#).Select
'löscht alle Shape-Objekte
Set s = Worksheets(1).Shapes
s.SelectAll
Selection.Delete

For i = 1 To 6 'Werte für QA bis SK
wert(i) = ActiveSheet.Cells(i, 5)
Next i
For i = 7 To 11 'Werte für PK bis VR
wert(i) = ActiveSheet.Cells(i - 6, 7)
Next i

top_ = 205 'Anfangsposition von Oben des Dokuments

For i = 1 To 11
hold_ = left_ 'Wert vorheriges Objekt merken zwecks verbinden
left_ = (wert(i) * 141) + (wert(i) - 3) * 1.5 'Berechnung Position von links
'Angaben für (Type, Left, Top, Width, Height)
Set donuts(i) = s.AddShape(msoShapeDonut, left_, top_, 30, 30)
If i >= 9 Then top_ = top_ - 18
top_ = top_ + 64.7

Next i

For i = 1 To 10
Set c = s.AddConnector(msoConnectorStraight, 0, 0, 0, 0)
With c.ConnectorFormat
.BeginConnect ConnectedShape:=donuts(i), ConnectionSite:=5
.EndConnect ConnectedShape:=donuts(i + 1), ConnectionSite:=1
c.RerouteConnections
End With
Next i

'Setzt Formatierungen für Donuts
With s.Range(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11))
.Fill.Visible = msoTrue 'sichtbar
.Fill.Solid 'ausgefüllt
.Fill.ForeColor.SchemeColor = 10 'ROT
.Fill.Transparency = 0 'kein Schatten
End With

End Sub

Lumpensammler
19.01.2005, 16:17
Hallo, robinho,

einen Tipp: alle Variablen müssen explizit deklariert werden. Bei
Dim top_, left_, hold_ As Single
ist einzig _hold als Single dimensioniert, top_ und left_ sind vom Typ Variant.

Gruß
LS