Excel VBA使脚本异步 [英] Excel VBA make a script asynchronous
问题描述
我有一个脚本,可以对计算机列表执行ping操作,并根据获得结果的时间来更改其背景颜色.
I have a script that can ping a list of computers and change their background color depending after the result it gets.
我的问题是,它在运行时会阻止整个excel文件.
My problem is, that it blocks the entire excel file while it runs.
所以我的问题是,如何使其异步运行?
So my question is, how can I make it to run async?
这是代码:
'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
推荐答案
不幸的是,由于VBA在单个线程中运行,因此您不能对此做太多事情.
You can't do too much about this unfortunately since VBA runs in a single thread.
不过,您可以通过放置
VBA.DoEvents()
在代码中的各个位置,最好是在紧密循环中.在您的情况下,请将它们放在包含For
的行之后.这将暂停VBA并刷新事件队列,从而使Excel响应.
in various places in your code, ideally in the tight loops. In your case, put them just after the lines containing For
. This pauses the VBA and flushes the event queue which will have the effect of making Excel responsive.
(切换屏幕更新不是一个好主意,因为如果函数意外终止,您可能会处于糟糕的状态.如果我是我,则删除执行该操作的行.)
(Toggling the screen updating is a bad idea since you might leave things in a bad state if the function terminates unexpectedly. I'd remove the lines that do that if I were you.)
这篇关于Excel VBA使脚本异步的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!