moving shapes with wait method

[tmischler]

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

 

[tmischler]

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]

Hi, tmischler,

try this

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]

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

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 ...

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]

That's brilliant thanks Erik - would have taken me years to get there - thanks loads...

 

[erik.van.geit]

You're welcome,

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

kind regards,
Erik