Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1584to1588
1584to1588
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Shapes (Kreise + Pfeile) automatisch anordnen

Forumthread: Shapes (Kreise + Pfeile) automatisch anordnen

Shapes (Kreise + Pfeile) automatisch anordnen
12.10.2017 16:02:04
Sophie
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
Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Shapes (Kreise + Pfeile) automatisch anordnen
12.10.2017 16:06:51
Andi11
Ich habe absolut keine Ahnung
Hoffe ich konnte dir dennoch helfen
MfG Andi
AW: Shapes (Kreise + Pfeile) automatisch anordnen
12.10.2017 16:20:28
Rainer
Hallo Sophie,
das klingt ein wenig nach "Das Problem des Handlungsreisenden"?
Ohne Beispielmappe wird das schwierig.
Ich stelle deinen Beitrag wieder auf OFFEN.
Gruß,
Rainer
AW: Shapes (Kreise + Pfeile) automatisch anordnen
12.10.2017 16:39:19
Sophie
Hallo Rainer,
ja, da hast du Recht. Es geht in die Richtung des Traveling Salesman Problem. Inhaltlich ist es leider nicht ganz so trivial. Aber das ist ja auch erstmal nebensächlich. Es geht zumindest um ein kombinatorisches Optimierungsproblem.
Ich versuche eine Beispielmappe fertig zu machen und hochzuladen.
Vielen Dank schon einmal und Gruss
Sophie
Anzeige
AW: Shapes (Kreise + Pfeile) automatisch anordnen
12.10.2017 17:14:56
Sophie
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

Anzeige
AW: Shapes (Kreise + Pfeile) automatisch anordnen
12.10.2017 17:52:27
Zwenn
Hallo Sophie,
interessantes Problem, aber alles andere als trivial glaube ich. Das dürfte in Richtung Simplex Verfahren gehen. Genauer Network Simplex Methode Dazu kannst Du mal googeln. Z.B. network simplex methode graphen zeichnen. Dann kommst Du auf solche Erklärungen:
https://de.wikipedia.org/wiki/Netzwerk-Simplexmethode
https://www.rpe.informatik.uni-kiel.de/de/rechnergestutzte-programmentwicklung/dateien/forschungunddiplomarbeiten/Diplom-Maier.pdf
Am ehesten wirst Du aber selber sehen können, was Du da wirklich brauchst denke ich.
Viele Grüße,
Zwenn
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige