使用Excel VBA设置文本大小动画

我的目标是使用VBA增加Excel中文本框的字体大小。虽然这很简单，但让这个问题更有趣的是，我需要从字体大小x平滑过渡到字体大小y——动画

我目前正在使用以下代码：

Option Explicit

Sub AnimateHit()
    Dim i As Integer
    For i = 1 To 25
        ActiveSheet.Shapes.Range(Array("textEnemyHit")).Select
        Selection.ShapeRange.TextFrame2.TextRange.Font.Size = i * 10
        'Waits for 50ms
        Call DelayMs(550)
        Application.ScreenUpdating = True
    Next
End Sub

'Code from http://stackoverflow.com/questions/18602979/how-to-give-a-time-delay-of-less-than-one-second-in-excel-vba
Private Sub DelayMs(ms As Long)
    Debug.Print TimeValue(Now)
    Application.Wait (Now + (ms * 0.00000001))
    Debug.Print TimeValue(Now)
End Sub

如果延迟为600ms或更大，则此代码有效。但是，在600ms以下，该代码不起作用。从最小字体大小跳到最大字体大小时，没有平滑过渡

关于如何以更快的帧速率实现平滑过渡，有什么想法吗

---

谢谢

问题可能出在您的硬件上。我试过这样做，效果非常棒——它的动画非常流畅

Sub AnimateHit()

    Dim i As Integer
    For i = 1 To 25
        [set_fehler_tab2].Font.Size = i * 10

        Call DelayMs(50)
        Application.ScreenUpdating = True
    Next

End Sub

Private Sub DelayMs(ms As Long)
    Debug.Print TimeValue(Now)
    Application.Wait (Now + (ms * 0.00000001))
    Debug.Print TimeValue(Now)
End Sub

---

我使用的是i7、Windows7和Office 2010。

我在测试宏时遇到了同样的问题

所以我换成了这个，它成功了

Private Declare Function GetTickCount Lib "kernel32" () As Long

Option Explicit

Sub AnimateHit()
    Dim i As Integer
    ActiveSheet.Shapes.Range(Array("textEnemyHit")).Select
    For i = 1 To 25
        Selection.ShapeRange.TextFrame2.TextRange.Font.Size = i * 10
        WasteTime (50)
    Next
End Sub

Sub WasteTime(Finish As Long)
' from http://www.myonlinetraininghub.com/pausing-or-delaying-vba-using-wait-sleep-or-a-loop
Dim NowTick As Long
Dim EndTick As Long

EndTick = GetTickCount + Finish
Do
    NowTick = GetTickCount
    DoEvents
Loop Until NowTick >= EndTick

End Sub

---

Excel在与GUI通信方面非常慢，因此您需要尽可能优化代码。删除debug.prints，不要每次在循环中都选择形状在开始时为它设置一个变量&使用该变量引用它，不要继续设置application.screen更新可能是硬件软件组合问题，正如你所说，因为我尝试了你的代码（只是更改范围引用）同样，但结果相同：没有动画。而我的答案中的代码得到了动画效果