moving shapes with wait method

tmischler

Well-known Member
Joined
Jun 17, 2004
Messages
669
Hi there,

Does anyone have any idea why the following code doesn't work?


Sub Macro4()

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)


Static i As Long
For i = 1 To 10


ActiveSheet.Shapes("Rectangle 1").Select
Selection.ShapeRange.IncrementLeft -20
Application.Wait waitTime

Next i

End Sub
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

tmischler

Well-known Member
Joined
Jun 17, 2004
Messages
669
Ok - first problem solved. Next problem is that the below code works if newSecond = Second(Now()) + 1 but not if newSecond = Second(Now()) + 0.5 any ideas anyone? Basically, I am just trying to make the shape move smoothly.

Sub Macro4()

Static i As Long

For i = 1 To 40
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 0.5

waitTime = TimeSerial(newHour, newMinute, newSecond)
ActiveSheet.Shapes("Rectangle 1").Select
Selection.ShapeRange.IncrementLeft -10
Application.Wait waitTime
Next i

End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi, tmischler,

try this

Code:
Sub speedregulator()
Do
  delay = Timer + 0.05
  Do Until Timer > delay
  DoEvents
  Loop
ActiveSheet.Shapes("Rectangle 1").Select
Selection.ShapeRange.IncrementLeft -1
Loop
End Sub

kind regards,
Erik
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Some furhter research brought me this.

great advantage: you don't need to select the shape
you can freely select cells and work on the sheet while your shape is moving

Code:
Sub speedregulator()
Do
  delay = Timer + 0.05
  Do Until Timer > delay
  DoEvents
  Loop
With ActiveSheet.Shapes("Rectangle 1")
.Left = .Left - 1
End With
Loop
End Sub

and playing around ...
Code:
Sub speedregulator()
d = 1.5
mind = 0 * d
maxd = 20 * d
ActiveSheet.Shapes("Rectangle 1").Left = maxd
Do
  delay = Timer + 0.2
  Do Until Timer > delay
  DoEvents
  Loop
With ActiveSheet.Shapes("Rectangle 1")
.Left = .Left - d
If .Left = mind Or .Left = maxd Then d = -d
Range("A1") = Format(.Left, "#")
End With
Loop
End Sub
still some Dim statements to add..
is this getting you further?

kind regards,
Erik
 

tmischler

Well-known Member
Joined
Jun 17, 2004
Messages
669
That's brilliant thanks Erik - would have taken me years to get there - thanks loads...
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
You're welcome,

Just elaborating what the guys and girls learned me here :coffee:
patience, you can get there too !

kind regards,
Erik
 

Forum statistics

Threads
1,147,621
Messages
5,742,193
Members
423,710
Latest member
Duarte85

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top