Excel VBA：移动对象的动画

Question

这是一个奇怪的问题。我有一个speadsheet我可以移动一些图片，我正在尝试创建一个更流畅的“动画”。整个运动应该是20，所以我试图在这个例子中拆分它（如果我让它工作，我希望增加一些帧）。但问题是，你永远不会看到第一个动作，只看到最后一个动作。关于如何实现这样的事情的任何想法？

我试过没有运气添加ScreenUpdating和AplicationWait命令。

Public PositionTop As Double
Public PositionLeft As Double
_______________________________________
Sub Animation()
    Application.ScreenUpdating = False
    Worksheets("Sheet1").Activate

    'Frame 1
    With ActiveSheet
        .Shapes.Range(Array("RandomPicture")).Select
        .Shapes("RandomPicture").Top = PositionTop + 10
        .Shapes("RandomPicture").Left = PositionLeft
    End With

    Application.ScreenUpdating = True
    Application.ScreenUpdating = False

    'Frame 2
    With ActiveSheet
        .Shapes.Range(Array("RandomPicture")).Select
        .Shapes("RandomPicture").Top = PositionTop + 20
        .Shapes("RandomPicture").Left = PositionLeft
    End With

    Application.ScreenUpdating = True

    PositionTop = PositionTop + 20

    Worksheets("Sheet1").Cells(1, 1).Select

End Sub
______________________________________________
Sub ResetAnimation()
    PositionTop = 10
    PositionLeft = 20
    Worksheets("Sheet1").Activate

    With ActiveSheet
        .Shapes.Range(Array("RandomPicture")).Select
        .Shapes("RandomPicture").Top = PositionTop
        .Shapes("RandomPicture").Left = PositionLeft
    End With

    Worksheets("Sheet1").Cells(1, 1).Select
End Sub

Answer 1

解释上面的评论，您可以尝试这样的事情：

Dim i as long
With ActiveSheet
    For i = 10 To 100 Step 10
        .Shapes("RandomPicture").Left = i
        Application.Wait(Now + TimeValue("0:00:01"))
        DoEvents
    Next
End With

上面的代码将每秒移动您的对象10步。 HTH。

Answer 2

以下内容将使应用程序在运行其余代码之前等待一段特定时间：

Public PositionTop As Double
Public PositionLeft As Double

Sub Animation()
    Worksheets("Sheet1").Activate

    'Frame 1
    With ActiveSheet
        .Shapes.Range(Array("RandomPicture")).Select
        .Shapes("RandomPicture").Top = PositionTop + 10
        .Shapes("RandomPicture").Left = PositionLeft
    End With
Application.Wait (Now + TimeValue("0:00:01") / 2) 'wait half a second
'Application.Wait (Now + TimeValue("0:00:01")) 'wait a second

    'Frame 2
    With ActiveSheet
        .Shapes.Range(Array("RandomPicture")).Select
        .Shapes("RandomPicture").Top = PositionTop + 20
        .Shapes("RandomPicture").Left = PositionLeft
    End With
Application.Wait (Now + TimeValue("0:00:01") / 2)

    PositionTop = PositionTop + 20

    Worksheets("Sheet1").Cells(1, 1).Select

End Sub

Sub ResetAnimation()
    PositionTop = 10
    PositionLeft = 20
    Worksheets("Sheet1").Activate

    With ActiveSheet
        .Shapes.Range(Array("RandomPicture")).Select
        .Shapes("RandomPicture").Top = PositionTop
        .Shapes("RandomPicture").Left = PositionLeft
    End With

    Worksheets("Sheet1").Cells(1, 1).Select
End Sub