在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

Answer 2

工作表中的文本框有时在更改文本或格式时不会更新,甚至DoEvent命令也无济于事.

由于Excel中没有命令以刷新用户表单的方式刷新工作表,因此必须使用技巧强制Excel更新屏幕.

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

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

Answer 3

DoEvents在循环中拨打电话.

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