Question

我的Excel工具执行一项长任务，我试图通过在状态栏或工作表中的某个单元格中提供进度报告来对用户表示友好，如下所示。但屏幕不刷新，或在某些时候停止刷新（例如33％）。任务最终完成但进度条无用。

如何强制更新屏幕？

For i=1 to imax ' imax is usually 30 or so
    fractionDone=cdbl(i)/cdbl(imax)
    Application.StatusBar = Format(fractionDone, "0%") & "done..."
    ' or, alternatively:
    ' statusRange.value = Format(fractionDone, "0%") & "done..."

    ' Some code.......

Next i

我正在使用Excel 2003。

Answer 1

在循环中添加 DoEvents 功能，见下文。

您可能还需要确保状态栏对用户可见，并在代码完成时重置。

Sub ProgressMeter()

Dim booStatusBarState As Boolean
Dim iMax As Integer
Dim i As Integer

iMax = 10000

    Application.ScreenUpdating = False
''//Turn off screen updating

    booStatusBarState = Application.DisplayStatusBar
''//Get the statusbar display setting

    Application.DisplayStatusBar = True
''//Make sure that the statusbar is visible

    For i = 1 To iMax ''// imax is usually 30 or so
        fractionDone = CDbl(i) / CDbl(iMax)
        Application.StatusBar = Format(fractionDone, "0%") & " done..."
        ''// or, alternatively:
        ''// statusRange.value = Format(fractionDone, "0%") & " done..."
        ''// Some code.......

        DoEvents
        ''//Yield Control

    Next i

    Application.DisplayStatusBar = booStatusBarState
''//Reset Status bar display setting

    Application.StatusBar = False
''//Return control of the Status bar to Excel

    Application.ScreenUpdating = True
''//Turn on screen updating

End Sub

Answer 2

工作表中的文本框有时不会更新当他们的文字或格式改变，甚至 DoEvent命令没有帮助。

由于Excel中没有用于刷新工作表的命令在用户表单可以刷新的方式中，这是必要的使用技巧强制Excel更新屏幕。

以下命令似乎可以解决问题：

- ActiveSheet.Calculate    
- ActiveWindow.SmallScroll    
- Application.WindowState = Application.WindowState

Answer 3

在循环中拨打DoEvents。

这会影响性能，因此您可能只希望在每次，例如第10次迭代时调用它但是，如果你只有30，这几乎不是问题。

Answer 4

具体来说，如果您正在处理 UserForm ，那么您可以尝试重绘方法。如果您在表单中使用事件触发器，则可能会遇到 DoEvents 的问题。例如，在函数运行时按下的任何键都将由 DoEvents 发送。键盘输入将在屏幕更新之前处理，因此如果要通过按住其中一个键盘来更改电子表格中的单元格键盘上的箭头键，然后单元格更改事件将在主函数完成之前继续触发。

在某些情况下，用户窗体不会刷新，因为 DoEvents 会触发事件;但是，重绘将更新UserForm，即使其他事件紧跟上一个事件，用户也会在屏幕上看到更改。

在UserForm代码中，它很简单：

Me.Repaint

Answer 5

这对我有用：

ActiveWindow.SmallScroll down:=0

或更简单地说：

ActiveWindow.SmallScroll 0

Answer 6

这根本不是直接回答你的问题，而只是提供替代方案。我发现在许多长Excel计算中，大部分时间等待屏幕上都有Excel更新值。如果是这种情况，您可以在子前面插入以下代码：

Application.ScreenUpdating = False
Application.EnableEvents = False

并将此作为结束

Application.ScreenUpdating = True
Application.EnableEvents = True

我发现这通常会加速我正在使用的任何代码，以至于不必提醒用户进度。这只是你尝试的一个想法，它的有效性很大程度上取决于你的表和计算。

Answer 7

@Hubisans评论最适合我。

ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1

Answer 8

我还无法获得对继承的广泛代码的调查。确切地说，这个问题困扰了我几个月。使用DoEnvents的许多方法没有帮助。以上答案有所帮助。甚至与进度条结合使用时，将此Sub放置在代码中有意义的位置即可

Sub ForceScreenUpdate()
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Wait Now + #12:00:01 AM#
    Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

Answer 9

在用户表单上，有两件事对我有用：

我想在表单左侧有一个滚动条。为此，我首先必须在 Windows 10 的语言设置（设置->时间和语言->更改管理语言）中向“更改管理语言”添加阿拉伯语。该设置实际上是针对“更改非 Unicode 程序的语言”，我将其更改为阿拉伯语（阿尔及利亚）。然后在表单的属性中，我将“从右到左”属性设置为 True。从那里表单开始仍然画了一个部分幽灵右滚动条，所以我还不得不添加一个不寻常的定时消息框：

    Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 1
    Select Case InfoBox.Popup("Please wait.", AckTime, "This is your Message Box", 0)
    Case 1, -1
    End Select

我尝试了所有方法让屏幕再次重绘，以在表单中正确对齐显示第一个文本框，而不是部分在滚动条下方或至少紧邻滚动条，而不是在我想要的右侧 4 个像素处.最后，我从另一个 Stackoverflow 帖子（我现在找不到或者我会相信它）中得到这个，它就像一个魅力：

Me.Frame1.Visible = False
Me.Frame1.Visible = True

Answer 10

就我而言，问题在于试图在工作表上使一个形状可见而另一个不可见。

这是我在用户单击按钮 [形状] 后“停用”它的方法。这两个形状大小相同，位置相同，但“非活动”版本的颜色较暗，这是一个很好的方法，但它不起作用，因为更改 .visible = 后我永远无法让屏幕更新FALSE = TRUE，反之亦然。

该线程中的所有相关技巧均无效。但今天我找到了一个对我有用的解决方案，at this link on Reddit

本质上，您只需在进行更改的代码之后立即连续调用两次 DoEvents。现在为什么？我不能说，但它确实有效。

在Excel VBA中强制执行屏幕更新

10 个答案: