Как я могу запустить индикатор выполнения одновременно с другими модулями? - PullRequest
0 голосов
/ 24 января 2012

Я пытался адаптировать существующий код и не уверен, куда все должно идти.

Я создал пользовательскую форму, но вместо того, чтобы делать метку для индикатора выполнения, я настроил ее в виде списка, который должендля обновления по завершении других модулей.

У меня есть следующий код в одном модуле:

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

У меня есть другой модуль для запуска каждого модуля, который соответствует каждой записи списка в приведенном выше коде.Я могу заставить пользовательскую форму открывать и запускать код, описанный выше, но я не могу заставить ее работать одновременно со всеми другими обновлениями, что полностью противоречит цели этого.

Моя главная проблема заключается в следующем: гдеразместить соответствующую кодировку или как изменить вышеприведенную кодировку, чтобы она работала одновременно с модулями обновления данных?

Второй вопрос касается обновления записей списка по мере их заполнения.Как сейчас, список просто создает запись «бла-бла, обновление данных ...», и я хотел бы добавить обновление, чтобы запись списка добавляла «... Готово».в конце каждой записи, когда обновление соответствующих данных завершено.

Я пытался что-то вроде:

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

в конце модулей кода для каждого модуля данных, а не вставлять егов коде выше.Будет ли это работать или это будет идти куда-то еще?

Ответы [ 2 ]

1 голос
/ 25 января 2012

Нет необходимости иметь поддельный модуль обновления состояния. Добавьте обновление статуса в код, который запускает сам процесс обновления. Если код, выполняющий обновление, находится не в самой форме, я обычно создаю пару открытых методов в форме для использования в процессе обновления.

В пользовательской форме сделайте что-нибудь простое, как это:

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
0 голосов
/ 24 января 2012

Будет ли для вас вариант просто заменить ваш DoEvents простым Call для ваших модулей?так это будет выглядеть примерно так ...

ufUpdate.ListBox1.AddItem "Updating Data1…"
Call UpdateData1()
ufUpdate.ListBox1.List(0) = "Updating Data1… Done"
...