Position einer Linie abfragen

Hallo Excelfreunde,
ich suche nun schon seit länger Zeit eine Möglichkeit die Position eine Linie auszulesen (Anfangspunkt + Endpunkt).
Hintergrund ist folgender: In einem Tabellenblatt wird ein Formular ausgefüllt. Dazu können auch Bilder Hochgeladen werden. Um Auffälligkeiten in den Bildern zu verdeutlichen, kann der User mittels Linie / Kreis / ect. darauf hindeuten. Die Bilder sowie Linien usw. werden dann als Typ und Position ein einen Datenbank übertragen. Später, wenn das Formular wieder aufgerufen wird, werden die Bilder wieder aus einen Ordner geladen und positioniert sowie die Kreise und Linien wieder eingefügt. Die Größe und Positionen von Kreisen und Rechtecken sind soweit kein Problem. Nur bei den Linien (und Pfeilen) kann ich diese nicht verwenden.
Daher die Frage: wie kann ich aus einer bestehenden Linie den Startpunkt und Endpunkt auslesen um diese dann wieder später für das erzeugen wieder zu nutzen?
Besten Dank für die Hinweise.
Beste Grüße - Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Onur,
zum Beispiel so:

Dim S As Shape
Sub Linien_herstellen()
Const X = 400
Const Y = 300
Const R = 150
For Each S In ActiveSheet.Shapes
S.Delete
Next
Set S = ActiveSheet.Shapes.AddLine(X, Y, X + R, Y + R)
ZeigeRichtung "v1"
Set S = ActiveSheet.Shapes.AddLine(X, Y, X - R, Y + R)
ZeigeRichtung "v2"
Set S = ActiveSheet.Shapes.AddLine(X, Y, X - R, Y - R)
ZeigeRichtung "v3"
Set S = ActiveSheet.Shapes.AddLine(X, Y, X + R, Y - R)
ZeigeRichtung "v4"
End Sub
Sub ZeigeRichtung(Optional NeuerName As String)
If NeuerName  "" Then S.Name = NeuerName
S.Line.EndArrowheadStyle = msoArrowheadTriangle
Debug.Print S.Name, S.Left, S.Top, S.Height, S.Width, S.VerticalFlip, S.HorizontalFlip
Select Case CStr(S.HorizontalFlip) & CStr(S.VerticalFlip)
Case "00" 'zwischen 03:00 und 06:00
Debug.Print "Nach rechts und nach unten"
Debug.Print "Erste Punkt:  " & (S.Left) & " | " & (S.Top)
Debug.Print "Zweite Punkt: " & (S.Left + S.Width) & " | " & (S.Top + S.Height)
Case "0-1" 'zwischen 00:00 und 03:00
Debug.Print "Nach rechts und nach oben"
Debug.Print "Erste Punkt:  " & (S.Left) & " | " & (S.Top + S.Height)
Debug.Print "Zweite Punkt: " & (S.Left + S.Width) & " | " & (S.Top)
Case "-10" 'zwischen 06:00 und 09:00
Debug.Print "Nach links und nach unten"
Debug.Print "Erste Punkt:  " & (S.Left + S.Width) & " | " & (S.Top)
Debug.Print "Zweite Punkt: " & (S.Left) & " | " & (S.Top + S.Height)
Case "-1-1" 'zwischen 09:00 und 12:00
Debug.Print "Nach links und nach oben"
Debug.Print "Erste Punkt:  " & (S.Left + S.Width) & " | " & (S.Top + S.Height)
Debug.Print "Zweite Punkt: " & (S.Left) & " | " & (S.Top)
End Select
End Sub

Bei der Aufgabe von Daniel:
Du muss zusätzlich die relative Position und den Ratio speichern.
Keine Einfache Aufgabe.
Viel Erfolg
Yal

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread