it-swarm.com.ru

Индикатор выполнения в VBA Excel

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

Правка: Моя проблема с элементом управления progressbar, я не вижу панель «Ход», она просто завершается, когда форма всплывает. Я использую цикл и DoEvent, но это не работает. Кроме того, я хочу, чтобы процесс повторялся, а не один раз.

57
darkjh

Раньше в проектах VBA я использовал элемент управления метками с цветным фоном и настраивал размер в зависимости от прогресса. Некоторые примеры с похожими подходами можно найти в следующих ссылках:

  1. http://oreilly.com/pub/h/2607
  2. http://www.ehow.com/how_7764247_create-progress-bar-vba.html
  3. http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

Вот тот, который использует автофигуры Excel:

http://www.andypope.info/vba/pmeter.htm

35
Matt

Иногда достаточно простого сообщения в строке состояния:

Message in Excel status bar using VBA

Это очень просто реализовать :

Dim x               As Integer 
Dim MyTimer         As Double 

'Change this loop as needed.
For x = 1 To 50
    ' Do stuff
    Application.StatusBar = "Progress: " & x & " of 50: " & Format(x / 50, "0%")
Next x 

Application.StatusBar = False
126
eykanal

Вот еще один пример использования StatusBar в качестве индикатора выполнения. 

Используя некоторые символы Юникода, вы можете имитировать индикатор выполнения. 9608 - 9615 - это коды, которые я пробовал для баров. Просто выберите один в зависимости от того, сколько места вы хотите показать между столбиками. Вы можете установить длину бара, изменив NUM_BARS. Также с помощью класса вы можете настроить его для автоматической инициализации и освобождения StatusBar. Как только объект выходит из области видимости, он автоматически очищается и возвращает StatusBar обратно в Excel. 

' Class Module - ProgressBar
Option Explicit

Private statusBarState As Boolean
Private enableEventsState As Boolean
Private screenUpdatingState As Boolean
Private Const NUM_BARS As Integer = 50
Private Const MAX_LENGTH As Integer = 255
Private BAR_CHAR As String
Private SPACE_CHAR As String

Private Sub Class_Initialize()
    ' Save the state of the variables to change
    statusBarState = Application.DisplayStatusBar
    enableEventsState = Application.EnableEvents
    screenUpdatingState = Application.ScreenUpdating
    ' set the progress bar chars (should be equal size)
    BAR_CHAR = ChrW(9608)
    SPACE_CHAR = ChrW(9620)
    ' Set the desired state
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

Private Sub Class_Terminate()
    ' Restore settings
    Application.DisplayStatusBar = statusBarState
    Application.ScreenUpdating = screenUpdatingState
    Application.EnableEvents = enableEventsState
    Application.StatusBar = False
End Sub

Public Sub Update(ByVal Value As Long, _
                  Optional ByVal MaxValue As Long= 0, _
                  Optional ByVal Status As String = "", _
                  Optional ByVal DisplayPercent As Boolean = True)

    ' Value          : 0 to 100 (if no max is set)
    ' Value          : >=0 (if max is set)
    ' MaxValue       : >= 0
    ' Status         : optional message to display for user
    ' DisplayPercent : Display the percent complete after the status bar

    ' <Status> <Progress Bar> <Percent Complete>

    ' Validate entries
    If Value < 0 Or MaxValue < 0 Or (Value > 100 And MaxValue = 0) Then Exit Sub

    ' If the maximum is set then adjust value to be in the range 0 to 100
    If MaxValue > 0 Then Value = WorksheetFunction.RoundUp((Value * 100) / MaxValue, 0)

    ' Message to set the status bar to
    Dim display As String
    display = Status & "  "

    ' Set bars
    display = display & String(Int(Value / (100 / NUM_BARS)), BAR_CHAR)
    ' set spaces
    display = display & String(NUM_BARS - Int(Value / (100 / NUM_BARS)), SPACE_CHAR)

    ' Closing character to show end of the bar
    display = display & BAR_CHAR

    If DisplayPercent = True Then display = display & "  (" & Value & "%)  "

    ' chop off to the maximum length if necessary
    If Len(display) > MAX_LENGTH Then display = Right(display, MAX_LENGTH)

    Application.StatusBar = display
End Sub

Пример использования:

Dim progressBar As New ProgressBar

For i = 1 To 100
    Call progressBar.Update(i, 100, "My Message Here", True)
    Application.Wait (Now + TimeValue("0:00:01"))
Next
54
Zack Graber
============== This code goes in Module1 ============

Sub ShowProgress()
    UserForm1.Show
End Sub

============== Module1 Code Block End =============

Создать кнопку на рабочем листе; кнопка привязки к макросу "ShowProgress"

Создайте UserForm1 с 2 кнопками, индикатором, полем ввода, текстовым полем:

UserForm1 = canvas to hold other 5 elements
CommandButton2 = Run Progress Bar Code; Caption:Run
CommandButton1 = Close UserForm1; Caption:Close
Bar1 (label) = Progress bar graphic; BackColor:Blue
BarBox (label) = Empty box to frame Progress Bar; BackColor:White
Counter (label) = Display the integers used to drive the progress bar

======== Attach the following code to UserForm1 =========

Option Explicit

' This is used to create a delay to prevent memory overflow
' remove after software testing is complete

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub UserForm_Initialize()

    Bar1.Tag = Bar1.Width
    Bar1.Width = 0

End Sub
Sub ProgressBarDemo()
    Dim intIndex As Integer
    Dim sngPercent As Single
    Dim intMax As Integer
    '==============================================
    '====== Bar Length Calculation Start ==========

    '-----------------------------------------------'
    ' This section is where you can use your own    '
    ' variables to increase bar length.             '
    ' Set intMax to your total number of passes     '
    ' to match bar length to code progress.         '
    ' This sample code automatically runs 1 to 100  '
    '-----------------------------------------------'
    intMax = 100
    For intIndex = 1 To intMax
        sngPercent = intIndex / intMax
        Bar1.Width = Int(Bar1.Tag * sngPercent)
        Counter.Caption = intIndex


    '======= Bar Length Calculation End ===========
    '==============================================


DoEvents
        '------------------------
        ' Your production code would go here and cycle
        ' back to pass through the bar length calculation
        ' increasing the bar length on each pass.
        '------------------------

'this is a delay to keep the loop from overrunning memory
'remove after testing is complete
        Sleep 10

    Next

End Sub
Private Sub CommandButton1_Click() 'CLOSE button

Unload Me

End Sub
Private Sub CommandButton2_Click() 'RUN button

        ProgressBarDemo

End Sub

================= UserForm1 Code Block End =====================

============== This code goes in Module1 =============

Sub ShowProgress()
    UserForm1.Show
End Sub

============== Module1 Code Block End =============
9
John Harris

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

Вот сообщение в блоге, о котором я писал: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-Excel-vba/

Все, что вам нужно сделать, это импортировать форму и модуль в ваши проекты и вызвать индикатор выполнения с помощью: Call modProgress.ShowProgress (ActionIndex, TotalActions, Title .....)

Надеюсь, это поможет.

6
Ejaz Ahmed

Мне нравятся все решения, опубликованные здесь, но я решил это, используя условное форматирование в качестве панели данных на основе процента.

Conditional Formatting

Это применяется к ряду ячеек, как показано ниже. Ячейки, содержащие 0% и 100%, обычно скрыты, потому что они просто предоставляют контекст именованного диапазона ScanProgress (слева).

Scan progress

В коде я перебираю таблицу, делая какие-то вещи.

For intRow = 1 To shData.Range("tblData").Rows.Count

    shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count
    DoEvents

    ' Other processing

Next intRow

Минимальный код, выглядит прилично.

5
Lucretius

Привет модифицированная версия другого поста Marecki . Имеет 4 стиля

1. dots ....
2  10 to 1 count down
3. progress bar (default)
4. just percentage.

Прежде чем вы спросите, почему я не отредактировал этот пост, я сделал, и его отклонили, и мне было предложено опубликовать новый ответ.

Sub ShowProgress()

  Const x As Long = 150000
  Dim i&, PB$

  For i = 1 To x
  DoEvents
  UpdateProgress i, x
  Next i

  Application.StatusBar = ""
End Sub 'ShowProgress

Sub UpdateProgress(icurr As Long, imax As Long, Optional istyle As Integer = 3)
    Dim PB$
    PB = Format(icurr / imax, "00 %")
    If istyle = 1 Then ' text dots >>....    <<'
        Application.StatusBar = "Progress: " & PB & "  >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
    ElseIf istyle = 2 Then ' 10 to 1 count down  (eight balls style)
        Application.StatusBar = "Progress: " & PB & "  " & ChrW$(10111 - Val(PB) / 11)
    ElseIf istyle = 3 Then ' solid progres bar (default)
        Application.StatusBar = "Progress: " & PB & "  " & String(100 - Val(PB), ChrW$(9608))
    Else ' just 00 %
        Application.StatusBar = "Progress: " & PB
    End If
End Sub
2
ozmike
Sub ShowProgress()
' Author    : Marecki
  Const x As Long = 150000
  Dim i&, PB$

  For i = 1 To x
    PB = Format(i / x, "00 %")
    Application.StatusBar = "Progress: " & PB & "  >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
    Application.StatusBar = "Progress: " & PB & "  " & ChrW$(10111 - Val(PB) / 11)
    Application.StatusBar = "Progress: " & PB & "  " & String(100 - Val(PB), ChrW$(9608))
  Next i

  Application.StatusBar = ""
End SubShowProgress
2
user3294122

Что касается элемента управления progressbar в пользовательской форме, он не будет показывать никакого прогресса, если вы не используете событие repaint. Вы должны закодировать это событие внутри цикла (и, очевидно, увеличить значение progressbar).

Пример использования:

userFormName.repaint
2
PedroMVM

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

Следующая ссылка объясняет Хороший способ построения индикатора выполнения. Хорошо работает с большим объемом данных (~ 250K записей +): 

http://www.Excel-easy.com/vba/examples/progress-indicator.html

0
Bhushan K

Хорошая диалоговая форма прогресса, которую я искал . прогрессбар от alainbryden

очень прост в использовании и выглядит красиво.

edit: ссылка работает только для участников premium: / 

здесь это хороший альтернативный класс.

0
ya_dimon

Было много других замечательных постов, однако я хотел бы сказать, что теоретически вы сможете создать элемент управления REAL:

  1. Используйте CreateWindowEx() для создания индикатора выполнения

Пример C++:

hwndPB = CreateWindowEx(0, PROGRESS_CLASS, (LPTSTR) NULL, WS_CHILD | WS_VISIBLE, rcClient.left,rcClient.bottom - cyVScroll,rcClient.right, cyVScroll,hwndParent, (HMENU) 0, g_hinst, NULL);

hwndParent Должен быть установлен в родительское окно. Для этого можно использовать строку состояния или пользовательскую форму! Вот структура окна Excel, найденная в Spy ++:

 enter image description here

Поэтому это должно быть относительно просто с использованием функции FindWindowEx().

hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar")

После создания индикатора выполнения вы должны использовать SendMessage() для взаимодействия с индикатором выполнения:

Function MAKELPARAM(ByVal loWord As Integer, ByVal hiWord As Integer)
    Dim lparam As Long
    MAKELPARAM = loWord Or (&H10000 * hiWord)
End Function

SendMessage(hwndPB, PBM_SETRANGE, 0, MAKELPARAM(0, 100))
SendMessage(hwndPB, PBM_SETSTEP, 1, 0)
For i = 1 to 100
    SendMessage(hwndPB, PBM_STEPIT, 0, 0) 
Next
DestroyWindow(hwndPB)

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

0
Sancarn

Просто добавляю свою часть в вышеупомянутую коллекцию.

Если вам не хватает кода и, возможно, классного интерфейса. Проверьте мой GitHub для Progressbar для VBA enter image description here

настраиваемый:

 enter image description here

Dll предназначен для MS-Access, но должен работать на всех платформах VBA с небольшими изменениями. Существует также файл Excel с образцами. Вы можете свободно расширять упаковщики vba в соответствии с вашими потребностями.

Этот проект находится в стадии разработки, и не все ошибки покрыты. Так что ждите!

Вы должны беспокоиться о сторонних DLL-файлах, и если вы это делаете, пожалуйста, не стесняйтесь использовать любой надежный онлайн-антивирус перед внедрением DLL.

0
krish KM