如何与其他模块同时运行进度条?

时间:2012-01-24 18:25:16

标签: excel vba excel-vba excel-2007

我尝试调整现有代码,但不确定应该去哪里。

我创建了一个userform,但是我没有为进度条做标签,而是将其设置为一个列表框,该列表框应该在其他模块完成时更新。

我在一个模块中有以下代码:

Sub DoStuff()

    Dim ufUpdate As UUpdate
    Dim dtTime As Date

    'instantiate the userform
    Set ufUpdate = New UUpdate

    'display a step
    ufUpdate.ListBox1.AddItem "Updating Data1…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data2…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data3…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating Data…"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating …"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating …"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating …"

    dtTime = Now
    Do: DoEvents: Loop Until Now > dtTime + TimeValue("00:00:02")
    ufUpdate.ListBox1.AddItem "Updating is COMPLETE!"

    Unload ufUpdate

    Set ufUpdate = Nothing

End Sub

我有另一个模块来运行与上面代码中每个列表框条目相关的每个模块。我可以让userform打开并运行上面的代码,但我不能让它与所有其他更新同时运行,这完全违背了这个目的。

我主要关注的是:我在哪里放置相应的编码或如何更改上述内容以便它与数据更新模块同时运行?

第二个问题是关于在列表框条目完成时更新它们。现在,列表框只是创建条目“blah blah update data ...”,我想添加更新,以便列表框条目添加“...完成”。在相关数据更新完成时,在每个条目的末尾。

我尝试了类似的东西:

ufUpdate.ListBox1.List(0) = "blah blah updating...Done."

在每个数据模块的代码模块的末尾,而不是将其粘贴在上面的代码中。这会起作用还是会转移到其他地方?

2 个答案:

答案 0 :(得分:1)

不需要伪造的更新状态模块。将状态更新添加到运行实际更新过程的代码中。如果运行更新的代码不在表单本身上,我通常会在表单上创建几个公共方法以供更新过程使用。

在用户表单上执行以下简单操作:

Public Sub AddStatus(sStatusMessage As String)
   Me.ListBox1.AddItem sStatusMessage
   DoEvents
End Sub

Public Sub MarkAsDone()
   With Me.ListBox1
      .List(.ListCount - 1) = .List(.ListCount - 1) & "  Done."
      DoEvents
   End With
End Sub

然后,在实际执行更新的代码中,您可以执行以下操作:

ufUpdate.AddStatus "Updating data 1..."
Call UpdateData1
ufUpdate.MarkAsDone

ufUpdate.AddStatus "Updating data 2..."
Call UpdateData2
ufUpdate.MarkAsDone

答案 1 :(得分:0)

您只需将简单DoEvents的{​​{1}}替换为模块即可吗?所以它看起来像这样...

Call