Excel VBA: 屏幕在循环期间不刷新
Excel VBA: Screen doesn't refresh during loop
我正在尝试让图像在循环发生时消失并重新出现。当我逐步执行代码时,代码按预期工作,但是当我 运行 它时,屏幕在循环完成之前不会更新。
如果您想尝试,我已经尝试添加 DoEvents 和 ActiveWindow.SmallScroll 之类的东西 here but nothing seems to work. I have a feeling this problem may have something to do with my PC/settings/version of Excel and that the loop may work on some peoples' machines. I've uploaded a sample file here。
我的密码是:
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ToggleImage()
For i = 1 To 20
Application.ScreenUpdating = True
ActiveSheet.Shapes("Picture 1").Visible = False
ActiveSheet.Shapes("Picture 2").Visible = True
ActiveSheet.Shapes("Picture 1").Visible = True
ActiveSheet.Shapes("Picture 2").Visible = False
Sleep 50
Next
End Sub
附上示例工作簿。
DoEvents
必须有时间做活动 ;-)。所以如果你在睡眠后调用一次它是完全没有用的。它必须在 暂停期间工作。
以下应该有效:
Sub ToggleImage()
Dim dTime As Double
For i = 1 To 20
'ActiveSheet.Range("a1").Value = i
ActiveSheet.Shapes("Picture 1").Visible = False
ActiveSheet.Shapes("Picture 2").Visible = True
dTime = Time
Do While Time < dTime + 1 / 24 / 60 / 60 / 2
DoEvents
Loop
ActiveSheet.Shapes("Picture 1").Visible = True
ActiveSheet.Shapes("Picture 2").Visible = False
dTime = Time
Do While Time < dTime + 1 / 24 / 60 / 60 / 2
DoEvents
Loop
Next
End Sub
但是您无法将暂停时间缩短到 50 毫秒。即使刷新 sheet 也会花费更多时间。
我正在尝试让图像在循环发生时消失并重新出现。当我逐步执行代码时,代码按预期工作,但是当我 运行 它时,屏幕在循环完成之前不会更新。
如果您想尝试,我已经尝试添加 DoEvents 和 ActiveWindow.SmallScroll 之类的东西 here but nothing seems to work. I have a feeling this problem may have something to do with my PC/settings/version of Excel and that the loop may work on some peoples' machines. I've uploaded a sample file here。
我的密码是:
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ToggleImage()
For i = 1 To 20
Application.ScreenUpdating = True
ActiveSheet.Shapes("Picture 1").Visible = False
ActiveSheet.Shapes("Picture 2").Visible = True
ActiveSheet.Shapes("Picture 1").Visible = True
ActiveSheet.Shapes("Picture 2").Visible = False
Sleep 50
Next
End Sub
附上示例工作簿。
DoEvents
必须有时间做活动 ;-)。所以如果你在睡眠后调用一次它是完全没有用的。它必须在 暂停期间工作。
以下应该有效:
Sub ToggleImage()
Dim dTime As Double
For i = 1 To 20
'ActiveSheet.Range("a1").Value = i
ActiveSheet.Shapes("Picture 1").Visible = False
ActiveSheet.Shapes("Picture 2").Visible = True
dTime = Time
Do While Time < dTime + 1 / 24 / 60 / 60 / 2
DoEvents
Loop
ActiveSheet.Shapes("Picture 1").Visible = True
ActiveSheet.Shapes("Picture 2").Visible = False
dTime = Time
Do While Time < dTime + 1 / 24 / 60 / 60 / 2
DoEvents
Loop
Next
End Sub
但是您无法将暂停时间缩短到 50 毫秒。即使刷新 sheet 也会花费更多时间。