vba - Excel VBA 使脚本异步

Question

我有一个脚本，可以 ping 计算机列表并根据得到的结果更改其背景颜色。

我的问题是，它在运行时阻止整个 Excel 文件。

所以我的问题是，如何让它异步运行？

这是代码:

'ping
Function sPing(sHost) As String

Dim oPing As Object, oRetStatus As Object

Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
  ("select * from Win32_PingStatus where address = '" & sHost & "'")

For Each oRetStatus In oPing
    If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
        sPing = "timeout" 'oRetStatus.StatusCode <- error code
    Else
        sPing = sPing & vbTab & oRetStatus.ResponseTime & Chr(10)
    End If
Next
End Function

Sub pingall_Click()
Dim c As Range
Dim p As String

Application.ScreenUpdating = True

For Each c In ActiveSheet.Range("A1:N50")
    If Left(c, 7) = "172.21." Then
    p = sPing(c)
        If p = "timeout" Then
            c.Interior.ColorIndex = "3"
        ElseIf p < 16 And p > -1 Then
            c.Interior.ColorIndex = "4"
        ElseIf p > 15 And p < 51 Then
            c.Interior.ColorIndex = "6"
        ElseIf p > 50 And p < 4000 Then
            c.Interior.ColorIndex = "45"
        Else
            c.Interior.ColorIndex = "15"

        End If
    End If
Next c

Application.ScreenUpdating = False

Answer 1

遗憾的是，由于 VBA 在单线程中运行，因此您对此无法做太多事情。

但是，您可以通过放置来引入一定程度的响应能力

VBA.DoEvents()

在代码中的各个位置，最好是在紧密循环中。在您的情况下，将它们放在包含 For 的行之后。这会暂停 VBA 并刷新事件队列，从而使 Excel 具有响应能力。

(切换屏幕更新是一个坏主意，因为如果函数意外终止，您可能会使事情处于糟糕的状态。如果我是您，我会删除执行此操作的行。)