AW: Bewegen von Kreisen mit der Maus
01.09.2020 17:36:03
Kreisen
Hallo nochmal,
dass EXCEL KEIN Malprogramm ist weiß ich. Ich möchte hier auch nur die Ergebnisse der Berechnung grafisch darstellen.
Ich habe versucht das Problem selbst zu lösen und ein paar Bruchstücke im Internet gefunden, komme aber nicht mehr weiter. Irgendwie weiß ich nicht wie ich die Mausabfrage auslösen kann.
' ------------------------------------------------------------------------------------------------------
' Bestimmten Kreis an aktueller Mauskoordinate nach x,y verschieben und neue Mittelpunktskoordinaten zurückgeben
' ------------------------------------------------------------------------------------------------------
Sub verschiebeKreis()
Dim objcircle As Shape
Dim rng As Range
Dim pTargetPoint As POINTAPI
Dim lRetVal As Long
' ------------------------------------------------------------------------------------------------------
'Bestimmt die Koordinaten der aktuellen Mausposition
' ------------------------------------------------------------------------------------------------------
lRetVal = GetCursorPos(pTargetPoint)
mauspos.x = pTargetPoint.x
mauspos.y = pTargetPoint.y
Set objcircle = ActiveSheet.Shapes("Name") 'Name der Linie! - anpassen!
Set rng = objcircle.TopLeftCell
If rng.Column >= 2 Then
With objcircle
.Left = rng.offset(0, -2).Left
.Top = rng.offset(0, -2).Top
.Height = rng.offset(0, -2).Height
End With
End If
Set objcircle = Nothing
Set rng = Nothing
End Sub
'Beispiel
Private Sub OptionButton1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal x As Single, _
ByVal y As Single)
Dim xAlt As Single
Dim yAlt As Single
xAlt = x
yAlt = y
End Sub
Private Sub OptionButton1_MouseMove(ByVal Button As Integer, ByVal Shift As _
Integer, ByVal x As Single, ByVal y As Single)
If Button = 1 Then
OptionButton1.Left = OptionButton1.Left + (x - xAlt)
OptionButton1.Top = OptionButton1.Top + (y - yAlt)
TextBox1 = x & " " & y
End If
End Sub
Könnt Ihr mir bitte helfen.
