X,Y Koordinaten einer angeklickten Linie

Camille · 2014-09-05T18:11:19+00:00

Hallo liebes Forum, Ich suche seit einigen Tagen eine Möglichkeit ein eigentlich simples Problem zu lösen: Ich habe durch ein VBA-Modul verschiedene Linien in eine leeres Tabellenblatt gezeichnet. Jetzt möchte ich eine dieser Linien per Mausklick auswählen und die Koordinatenpunkte X1, Y1, X2, Y2 erhalten. Dabei sind: X1 und Y1 die X- und Y-Koordinate des Anfangspunktes der Linie X2 und Y2 die X- und Y-Koordinate des Endspunktes der Linie Ich habe mir immerhin schon den Namen meiner, per Mausklick ausgewählten, Linie über: Dim LinienName As String LinienName = Selection.ShapeRange.Name ausgeben lassen. Als Wert ergibt sich z.B. "Straight Connector 2310". Jetzt hatte ich gehofft über Dim X1 As Integer X1 = ActiveSheet.Shapes(LinienName).Nodes(1).Points(1, 1) mir die Koordinaten ausgeben zu lassen. Das klappt so einfach aber nicht. Dann habe ich es mit dieser Methode probiert: Dim Koor as Variant Dim X1 As Integer, Y1 as Integer Koor = ActiveSheet.Shapes(LinienName).Nodes.Item(1).Points X1 = Koor(1, 1) Y1 = Koor(1, 2) Doch das klappt auch nicht. Hat jemand eine Idee wie ich weiter machen kann? Mir gehen die Ideen aus und mit der normalen Hilfe von Microsoft komme ich leider auch nicht weiter. Ich bin für jeden Denkansatz und Vorschlag dankbar! Grüße Camille

Hallo Camille, hallo Mullit,
VerticalFlip und HorizontalFlip machen die Musik, aber sie war von Mullit noch nicht ganz zu Ende gespielt.
Mullits Makro berechnet die Koordinaten der beiden Endpunkte, unterscheidet aber noch nicht zwischen Start- und Endpunkt. Mit den folgenden Anpassungen werden auch diese berücksichtigt. X1/Y1 ist dann der Startpunkt, X2/Y2 der Endpunkt.

Public Sub test()
Dim sngX1Begin As Single, sngY1Begin As Single, _
sngX2End As Single, sngY2End As Single
If TypeOf Selection Is Line Then
With ActiveSheet.Shapes(Selection.Name)
sngX1Begin = .Left
sngX2End = .Left + .Width
If .HorizontalFlip = msoFalse Then
sngX1Begin = .Left
sngX2End = .Left + .Width
If .VerticalFlip = msoFalse Then
sngY1Begin = .Top
sngY2End = .Top + .Height
Else
sngY1Begin = .Top + .Height
sngY2End = .Top
End If
Else
sngX1Begin = .Left + .Width
sngX2End = .Left
If .VerticalFlip = msoFalse Then
sngY1Begin = .Top
sngY2End = .Top + .Height
Else
sngY1Begin = .Top + .Height
sngY2End = .Top
End If
End If
MsgBox .Name & vbCr & vbCr & "x1:  " & sngX1Begin & vbCr & _
"y1:  " & sngY1Begin & vbCr & "x2:  " & sngX2End & vbCr & "y2:  " & sngY2End
End With
Else
MsgBox "Bitte eine Linie auswählen!", vbExclamation
End If
End Sub

Hallo,
@Camille:
top::
@Franz:
Was willst Du mir da erzählen?
Du mußt wohl Dein Klavier mal nachstimmen....
Dein Programm ist falsch!
sngX1Begin
sngY1Begin
sind bei mir immer die Anfangskoordinaten.
sngX2End
sngY2End
sind bei mir immer die Endkoordinaten.
Beides wird in der Msgbox korrekt ausgegeben.
Dein Programm gibt falsche Werte aus, wenn man die Linien dreht:
In X1 steht dann bei Dir der grössere Wert und bei einer aufsteigenden Linie in Y1 der kleinere Wert, bei einer abfallenden Linie in Y1 der grössere Wert: Das ist natürlich genau verkehrt herum...
Du darfst dem X1 Wert nicht .Left + .Width und im doppelten True-Fall für HorizontalFlip und VerticalFlip dem Y1-Wert nicht .Top + .Height zuweisen!!
s.a.:

Public Sub test()
Dim sngX1Begin As Single, sngY1Begin As Single, _
sngX2End As Single, sngY2End As Single
If TypeOf Selection Is Line Then
With ActiveSheet.Shapes(Selection.Name)
sngX1Begin = .Left
sngX2End = .Left + .Width
If .HorizontalFlip = msoFalse Then
sngX1Begin = .Left
sngX2End = .Left + .Width
If .VerticalFlip = msoFalse Then
sngY1Begin = .Top
sngY2End = .Top + .Height
Else
sngY1Begin = .Top + .Height
sngY2End = .Top
End If
Else
sngX1Begin = .Left + .Width
sngX2End = .Left
If .VerticalFlip = msoFalse Then
sngY1Begin = .Top
sngY2End = .Top + .Height
Else
sngY1Begin = .Top + .Height
sngY2End = .Top
End If
End If
MsgBox .Name & vbCr & vbCr & "x1:  " & sngX1Begin & vbCr & _
"y1:  " & sngY1Begin & vbCr & "x2:  " & sngX2End & vbCr & " _
y2:  " & sngY2End
End With
Else
MsgBox "Bitte eine Linie auswählen!", vbExclamation
End If
End Sub

Gruß,

X,Y Koordinaten einer angeklickten Linie

Forumthread: X,Y Koordinaten einer angeklickten Linie

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial