X,Y Koordinaten einer angeklickten Linie

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit 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 .VerticalFlip = msoTrue And .HorizontalFlip = msoFalse Or _ .VerticalFlip = msoFalse And .HorizontalFlip = msoTrue Then sngY1Begin = .Top + .Height sngY2End = .Top Else sngY1Begin = .Top sngY2End = .Top + .Height 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 VBA/HTML - CodeConverter für Office-Foren AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann Projektbetreuung durch mumpel Code erstellt und getestet in Office 12

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ß,

Beliebteste Forumthreads (12 Monate)

X,Y Koordinaten einer angeklickten Linie

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

X,Y Koordinaten einer angeklickten Linie

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread