移动形状可见

Move Shape visible

我正在尝试用 VBA 移动 Excel 中的一组图片,效果很好,但我希望用户可以看到图片是如何移动的。

这是一个小游戏,"Horse Race"。

这是我移动马匹的代码。

Sub TrackProgress()
Dim Tracks() As GroupObject
Dim Agents(), HorseCount As Integer
Dim AgentCount As Integer
Dim TrackCount As Integer
Dim Progress As Double
Dim MaxPx As Double

AgentCount = Sheets("Config").Range("O5").Value
TrackCount = Round(AgentCount / HorsesPerTrack, 0)
ReDim Tracks(1 To TrackCount)
ReDim Agents(1 To AgentCount)
MaxPx = Sheets("Config").Range("O15").Value


Sheets("HorseRaceTrack").Select

For i = 6 To Sheets("Config").Cells(Rows.Count, 5).End(xlUp).Row

    If Sheets("Config").Cells(i, 4).Value = "Active" Then
        Agents(i - 5) = Sheets("Config").Cells(i, 5).Value
    End If

Next i

For i = 1 To AgentCount

    If Not IsError(Sheets("Config").Cells(i + 5, 7).Value) Then
        Progress = Sheets("Config").Cells(i + 5, 7).Value
        Do Until Sheets("HorseRaceTrack").Shapes("Horse_" & Agents(i)).Left >= (MaxPx * Progress)
            Sheets("HorseRaceTrack").Shapes("Horse_" & Agents(i)).IncrementLeft 1.3636220472
            'Sleep 1000 ' Pferd beweg sich nicht flüssig....
        Loop
    Else
        GoTo NextOne
    End If

NextOne:
Next i

End Sub

我已经尝试使用 "sleep 500" 但是屏幕也很卡

感谢您的帮助!

.IncrementLeft 之后紧跟 DoEvents。这应该允许工作表在移动时显示形状。

通过调整增量的大小,可以让动作加速或减速。