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 也会花费更多时间。