MorganO
Active Member
- Joined
- Nov 21, 2006
- Messages
- 483
I have been learning to manipulate shapes in VBA and have come across a problem that I can't quite crack. I am attempting to have a worksheet shape autocenter itself on my mouse pointer as I move the mouse. It nearly works, but the shape does not quite land on the mouse cursor as it should - it is offset down and to the right.
I know that the problem lies within the difference between the values returned for the mouse position (the entire Excel Window) versus the position returned for the shape object (the worksheet Window) [Due to the toolbars and row 'header'] but I just can't seem to find a proper solution for determining the proper 'offset' factor.
Can someone point me in the right direction?
I've attached the code I have so far below:
Thanks.
Owen
I know that the problem lies within the difference between the values returned for the mouse position (the entire Excel Window) versus the position returned for the shape object (the worksheet Window) [Due to the toolbars and row 'header'] but I just can't seem to find a proper solution for determining the proper 'offset' factor.
Can someone point me in the right direction?
I've attached the code I have so far below:
Code:
Sub MouseMoveObjectTest()
Dim lngCurPos As POINTAPI
For Each sp In Worksheets("Sheet1").Shapes
sp.Delete
Next
Set a = Worksheets("Sheet1").Shapes.AddShape(92, 50, 50, 20, 20)
a.Name = "Oval2"
a.Fill.ForeColor.SchemeColor = False
Do
GetCursorPos lngCurPos
' Find the Center of the Stationary and Moving Object
CenterRowStationary = lngCurPos.Y
CenterColStationary = lngCurPos.x
CenterRowMoving = Shapes("Oval2").Top + Shapes("Oval2").Height / 2
CenterColMoving = Shapes("Oval2").Left + Shapes("Oval2").Width / 2
MovementSpeed = 1.25
' Now comes the hard part. I want the object to follow a straight path to the stationary
' object, so I will need to use Right Triangle Math to do this.
' First, I need to determine the Hypotenus of the Right Triangle give the height and width
' of the right triangle
TriangleHeight = Abs(CenterRowStationary - CenterRowMoving)
TriangleWidth = Abs(CenterColStationary - CenterColMoving)
TriangleHyp = Sqr(TriangleHeight ^ 2 + TriangleWidth ^ 2)
' Ok, now I will need to use the movement speed (which is the hypotenuse of a smaller
' right triangle within the larger right triangle above) to determine the height and width
' of this new triangle. These values are directly proportional to the values in the above
' triangle.
If TriangleHeight = 0 Then
NewTriangleHeight = 0
Else
NewTriangleHeight = (TriangleHeight / TriangleHyp) * MovementSpeed
End If
If TriangleWidth = 0 Then
NewTriangleWidth = 0
Else
NewTriangleWidth = (TriangleWidth / TriangleHyp) * MovementSpeed
End If
' These new values are the row and column adjustment factors we will use to move
' the object.
With Shapes("Oval2")
If (.Top + Shapes("Oval2").Height / 2) > CenterRowStationary Then .Top = .Top - NewTriangleHeight
If (.Top + Shapes("Oval2").Height / 2) < CenterRowStationary Then .Top = .Top + NewTriangleHeight
If (.Left + Shapes("Oval2").Width / 2) > CenterColStationary Then .Left = .Left - NewTriangleWidth
If (.Left + Shapes("Oval2").Width / 2) < CenterColStationary Then .Left = .Left + NewTriangleWidth
End With
DoEvents
Loop
End Sub
Thanks.
Owen