vba - 在 Excel VBA 中强制屏幕更新

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