Animation of shapes in Visio via VBA - vba

Question

Is it possible to, f.ex., rotate shapes or change different (boolean) settings like visibilty by giving commands via the object's ID or is prior selecting necessary?
As far as I got it, I have to select an deselect each item prior to change its characteristics/ data.
My code looks like this (shall produce an "animation" of blinking arrows):
Private Sub timeout(duration_ms As Double)
Start_Time = Timer
Do
DoEvents
Loop Until (Timer - Start_Time) >= duration_ms
End Sub
Private Sub cmd_blinking_Click()
rep_count = 0
Target = 400
blink = 0.3
Do Until rep_count = Target
DoEvents
rep_count = rep_count + 1
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(255), visSelect
Application.ActiveWindow.Selection.Visible = True
ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(256), visSelect
Application.ActiveWindow.Selection.Visible = False
ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(257), visSelect
Application.ActiveWindow.Selection.Visible = False
ActiveWindow.DeselectAll
timeout (blink)
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(256), visSelect
Application.ActiveWindow.Selection.Visible = True
ActiveWindow.DeselectAll
timeout (blink)
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(257), visSelect
Application.ActiveWindow.Selection.Visible = True
ActiveWindow.DeselectAll
timeout (blink*3)
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(255,256,257), visSelect
Application.ActiveWindow.Selection.Visible = False
ActiveWindow.DeselectAll
timeout (blink * 0.9)
Loop
End Sub
Easier way I am looking for if possible:
Private Sub timeout(duration_ms As Double)
Start_Time = Timer
Do
DoEvents
Loop Until (Timer - Start_Time) >= duration_ms
End Sub
Private Sub cmd_blinking_Click()
rep_count = 0
Target = 400
blink = 0.3
Do Until rep_count = Target
DoEvents
rep_count = rep_count + 1
ActiveWindow.Shapes.ID(255).Visible = True
ActiveWindow.Shapes.ID(256).Visible = False
ActiveWindow.Shapes.ID(257).Visible = False
timeout (blink)
ActiveWindow.Shapes.ID(256).Visible = True
timeout (blink)
ActiveWindow.Shapes.ID(257).Visible = False
timeout (blink * 3)
ActiveWindow.Shapes.ID(255).Visible = False
ActiveWindow.Shapes.ID(256).Visible = False
ActiveWindow.Shapes.ID(257).Visible = False
timeout (blink * 0.9)
Loop
End Sub

Answer 1

For anyone looking for "animated arrows" in VBA (as I was asking):
The function is for making a pause in between the appearance of the individual objects / shapes.
Afterwards the objects/shapes need to change their Visibility property to make an "blinking effect".
In my example I used three arrows with specific given names ("Left_Arrow_1", etc.), here the object names must be inserted. By making a macro for inserting objects an giving them defined names, this is making things easier.
Sub timeout(duration_ms As Double)
Start_Time = Timer
Do
DoEvents
Loop Until (Timer - Start_Time) >= duration_ms
End Sub
Sub blinking_arrows()
rep_count = 0
target = 400
blink = 0.3
Do Until rep_count = target
DoEvents
rep_count = rep_count + 1
Sheet1.Shapes("Left_Arrow_1").Visible = True
Sheet1.Shapes("Left_Arrow_2").Visible = False
Sheet1.Shapes("Left_Arrow_3").Visible = False
timeout (blink)
Sheet1.Shapes("Left_Arrow_2").Visible = True
timeout (blink)
Sheet1.Shapes("Left_Arrow_3").Visible = True
timeout (blink * 3)
Sheet1.Shapes("Left_Arrow_1").Visible = False
Sheet1.Shapes("Left_Arrow_2").Visible = False
Sheet1.Shapes("Left_Arrow_3").Visible = False
timeout (blink * 0.9)
Loop
End Sub