Shapes (Kreise + Pfeile) automatisch anordnen

Hallo zusammen,
Bei meinem Problem dreht es sich um Shapes (Kreise), die mit Pfeilen verbunden sind.
Die Kreise und Pfeile werden abhängig von den zugrundeliegenden Daten mit verschiedenen Makros erstellt.
Ich bin kein VBA-Profi, aber bis hier hin habe ich mich ganz gut durchgewurschtelt.
Die Kreise werden in meinem Makro auf einem Sheet alle nebeneinander angeordnet. Es sind, abhängig wie gross die Datenmenge am Anfang ist, ungefähr 10-30 Kreise, die kreuz und quer miteinander verbunden sind (Pfeile zeigen quasi Abhängigkeiten an).
PROBLEM: Nun möchte ich die Shapes (Kreise) so auf dem Sheet verteilen bzw. neu anordnen (natürlich aber automatisch mit VBA, da sich die Daten immer wieder ändern), sodass sich so wenige Pfeile wie möglich kreuzen. Damit versuche ich das Bild/Visualisierung übersichtlicher zu gestalten.
Also anders: die Kreuzungspunkte möchte ich minimieren und die Shapes sollen einen Mindestabstand zueinander haben und sich somit nicht überschneiden oder berühren.
FRAGE: Ist sowas generell mit VBA möglich? Wenn ja, welche Möglichkeiten gibt es dafür? Ich recherchiere dann auch gerne selber dazu weiter :)
Über Input und Ideen freue ich mich sehr!
Viele Grüsse
Sophie

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Unten mein Code in abgespeckter Form. Ich hoffe, dass es noch Sinn ergibt, da ich es etwas anonymisiert und verkürzt habe. Es sind zwei Subs. Mit dem ersten erstelle ich die Kreise. Mit dem zweiten die Pfeile. Ist das so ausreichend? Von seltsamen Dimensionierungen oder komischen Umsetzungsarten bitte ich abzusehen... Ich habe versucht mir das in den letzten Tagen irgendwie anzueignen.

Sub Kreise_erstellen()
Dim c As Worksheet
Dim LastRowC As Long
Dim i As Integer
Dim Kreis As Shape
Dim x As Integer
Dim y As Integer
Dim Beispieltext As String
Dim s As Integer
x = 50
y = 50
s = 1
Set c = ThisWorkbook.Worksheets("Zwischenablage")
LastRowC = c.Range("A1").CurrentRegion.Rows.Count
'Neues Sheet mit dem Namen "Kreise" anlegen
Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "Kreise"
Dim d As Worksheet
Set d = ThisWorkbook.Worksheets("Kreise")
'Zeichnet die benötigten Kreise mit Beispieltext
For i = 2 To LastRowC
If c.Cells(i, 1).Value  "" Then
Set Kreis = ActiveSheet.Shapes.AddShape(msoShapeOval, x, y, 100, 100)
Kreis.Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent4
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.6000000238
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
End With
Beispieltext = Worksheets("Zwischenablage").Cells(i, 1).Value
With Selection.ShapeRange.TextEffect
.FontName = "Arial"
.FontSize = 7
.Text = Beispieltext
End With
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes(s).Name = Beispieltext
End If
x = x + 150
s = s + 1
Next i
End Sub

Sub Pfeile()
'Pfeile zwischen den Kreisen einzeichnen
Dim c As Worksheet
Dim d As Worksheet
Dim LastRowC As Long
Dim LastColC As Long
Dim Beispieltext As String
Dim Beispieltext2 As String
Dim row As Integer
Dim col As Integer
Set c = ThisWorkbook.Worksheets("Zwischenablage")
Set d = ThisWorkbook.Worksheets("Kreise")
LastRowC = c.Range("A1").CurrentRegion.Rows.Count
LastColC = c.UsedRange.Columns.Count
For row = 2 To LastRowC
Beispieltext = Worksheets("Zwischenablage").Cells(row, 1).Value
For col = 2 To LastColC
If c.Cells(row, col)  "" Then
Beispieltext2 = Worksheets("Zwischenablage").Cells(row, col).Value
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 15, 10, 20, 10).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
Selection.ShapeRange.ConnectorFormat.BeginConnect ActiveSheet.Shapes(Beispieltext),  _
7
Selection.ShapeRange.ConnectorFormat.EndConnect ActiveSheet.Shapes(Beispieltext2),  _
3
End If
Next col
Next row
End Sub

Beliebteste Forumthreads (12 Monate)

Shapes (Kreise + Pfeile) automatisch anordnen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Shapes (Kreise + Pfeile) automatisch anordnen

5 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)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread