从VBA调用计算密集型例程而不会拖延Excel GUI

Question

我有一组数字密集的例程(每个最多需要1分钟完成)捆绑在一个COM对象中,IDispatch干净地实现.

因此,我可以在Excel工作表中使用它们,这些例程将由按钮触发的VBA宏调用.

现在,当调用其中一个例程时,Excel用户界面被冻结,这对于工作表的最终用户来说非常不舒服.

我想找到任何机制来缓解这个问题.

这可能是例如在COM端启动的另一个线程中启动计算,立即返回,生成的线程在计算结果时回调VBA过程.

或者更简单的东西,因为我一次只需要执行一次计算.

现在,从其他线程调用VBA例程可能存在很多问题.我必须承认,我不熟悉COM,我只把它当作代码和Excel之间的黑盒子(我使用ATL).

所以,

是否可以从另一个线程回调VBA例程？

有没有更好的方法来实现我想要实现的目标？

UPDATE

在权衡选项并在互联网上阅读大量内容后,我将进行合作多线程:在COM对象中,我将有三个:

class CMyObject : ...
{
    ...

    STDMETHOD(ComputationLaunch)(...); // Spawn a thread and return immediately
    STDMETHOD(ComputationQuery)(DOUBLE* progress, BOOL* finished);
    STDMETHOD(ComputationResult)(VARIANT* out);

private:
    bool finished, progress;
    boost::mutex finished_lock, progress_lock;
    ResultObject result; // This will be marshaled to out
                         // when calling ComputationResult
};

在VBA中:

Private computeActive as Boolean ' Poor man's lock

Public Sub Compute()

    OnError GoTo ErrHandler:

    If computeActive Then Exit Sub
    computeActive = True

    Dim o as MyObject
    call o.ComputationLaunch

    Dim finished as Boolean, progress as Double

    While Not o.ComputationQuery(progress)
        DoEvents
        ' Good place also to update a progress display
    End While

    Dim result as Variant
    result = o.ComputationResult

    ' Do Something with result (eg. display it somewhere)

    computeActive = False
    Exit Sub

ErrHandler:
    computeActive = False
    Call HandleErrors

End Sub

事实上,做互联网的COM加载项上的深度优先搜索,我意识到,VBA宏在同一事件循环与Excel的界面运行,你有DoEvents工具,而且它是不是安全的(或至少非常棘手)从其他线程回调VBA程序.这需要例如.欺骗Accesibility工具以获取Excel.Application对象的同步句柄,并调用该OnTime方法来设置异步事件处理程序.不值得麻烦.

Answer 1

我的肮脏技巧是：创建一个新的 Excel 实例，在那里运行代码。

另一种选择是安排稍后运行，让用户说出时间。（在下面的示例中，我只是硬编码了 5 秒。）这仍然会冻结用户界面，但会在预定的稍后时间冻结。

Sub ScheduleIt()
    Application.OnTime Now + TimeValue("00:00:05"), "DoStuff"
End Sub

Sub DoStuff()
    Dim d As Double
    Dim i As Long
    d = 1.23E+302
    For i = 1 To 10000000#
        ' This loop takes a long time (several seconds).
        d = Sqr(d)
    Next i
    MsgBox "done!"

End Sub