Отобразить процесс выполнения

Часто при создании кодов в VBA используется обращение к ячейкам, листам, книгам и т.д. и их обработка в циклах. Пара примеров подобных циклов:

• Просмотреть все файлы в папке - цикл по файлам в папке - Do While sFiles <> "" и For Each objFile In objFolder.Files
• Массовая замена слов - цикл по ячейкам(массивам) - For lr = 1 To UBound(avArr, 1)
• Не работают/пропали меню - цикл по всем панелям - For Each cmdBar In Application.CommandBars

Если операция в цикле выполняется за пару секунд - это вполне приемлемо и отражать графически подобные действия нет нужды. Но, если циклы "крутятся" по полчаса - вполне неплохо иметь возможность видеть на какой стадии цикл. Здесь есть один нюанс: циклы могут быть как с заранее известным кол-вом итераций, так и без этого понимания.
Цикл Do While из первого кода статьи Просмотреть все файлы в папке является циклом условия. Т.е. заранее неизвестно сколько файлов будет обработано и следовательно невозможно отразить прогресс выполнения задачи в процентах.
Циклы вроде For Each и For ... Next как правило дают возможность определить общее кол-во элементов к обработке, т.к. применяются как правило к коллекциям и объектам, у которых есть свойство .Count. Углубляться в этой статье не стану - это лишь предисловие, чтобы было ясно, почему и зачем далее в статье продемонстрированы разные подходы отображения процесса выполнения.
Отобразить же процесс можно двумя способами:

• Использование Application.StatusBar
• Использование UserForm

Application.StatusBar = "Привет"

Чтобы сбросить значения StatusBar и передать управление им обратно самому Excel необходимо выполнить строку:

Application.StatusBar = False

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

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'показываем этап выполнения
        Application.StatusBar = "Обрабатывается файл '" & sFiles & "'"
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом
        'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru
        ActiveWorkbook.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
        'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close True 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
    'сбрасываем значение статусной строки
    Application.StatusBar = False
End Sub

Если запустить код, то перед открытием каждой книги в строке StatusBar будет показано какой именно файл отрывается и обрабатывается. И так с каждым файлом:

Sub ShowProgressBar()
    Dim lAllCnt As Long, lr as Long
    Dim rc As Range
    'кол-во ячеек в выделенной области
    lAllCnt = Selection.Count
    'цикл по всем ячейкам в выделенной области
    For Each rc In Selection
        'прибавляем 1 при каждом шаге
        lr = lr + 1
        Application.StatusBar = "Выполнено: " & Int(100 * lr / lAllCnt) & "%"
        DoEvents 'чтобы форма перерисовывалась
    Next
    'сбрасываем значение статусной строки
    Application.StatusBar = False
End Sub

В строке статуса это будет выглядеть так:

Но можно показывать информацию и в чуть более изощренных формах:
Вариант отображения % и блоками-цифрами от 1 до 10(1 = 10% выполнения)

Sub StatusBar1()
    Dim lr As Long, lrr As Long, lp As Double
    Dim lAllCnt As Long 'кол-во итераций
    Dim s As String
    lAllCnt = 10000
    'основной цикл
    For lr = 1 To lAllCnt
        lp = lr \ 100 'десятая часть всего массива
        s = ""
        'формируем строку символов(от 1 до 10)
        For lrr = 10102 To 10102 + lp \ 10
            s = s & ChrW(lrr)
        Next
        'выводим текущее состояние выполнения
        Application.StatusBar = "Выполнено: " & lp & "% " & s: DoEvents
        DoEvents
    Next
    'очищаем статус-бар от значений после выполнения
    Application.StatusBar = False
End Sub

Вариант отображения % и стрелками ->(1 стрелка = 10% выполнения)

Sub StatusBar2()
    Dim lr As Long, lp As Double
    Dim lAllCnt As Long 'кол-во итераций
    Dim s As String
    lAllCnt = 10000
    For lr = 1 To lAllCnt
        lp = lr \ 100 'десятая часть всего массива
        'формируем строку символов(от 1 до 10)
        s = String(lp \ 10, ChrW(10152)) & String(11 - lp \ 10, ChrW(8700))
        Application.StatusBar = "Выполнено: " & lp & "% " & s: DoEvents
        DoEvents
    Next
    'очищаем статус-бар от значений после выполнения
    Application.StatusBar = False
End Sub

Вариант отображения % и квадратами (кол-во квадратов можно изменять. Если lMaxQuad=20 - каждый квадрат одна 20-я часть всего массива)

Sub StatusBar3()
    Dim lr As Long
    Dim lAllCnt As Long 'кол-во итераций
    Const lMaxQuad As Long = 20 'сколько квадратов выводить
    lAllCnt = 10000
 
    For lr = 1 To lAllCnt
        Application.StatusBar = "Выполнено: " & Int(100 * lr / lAllCnt) & "%" & String(CLng(lMaxQuad * lr / lAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lr / lAllCnt), ChrW(9633))
        DoEvents
    Next
    'очищаем статус-бар от значений после выполнения
    Application.StatusBar = False
End Sub

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

• создаем UserForm (в меню VBE -Insert -UserForm. Подробнее про вставку модулей и форм - Что такое модуль? Какие бывают модули?)
• отображаем окно конструктора(если не отображено): View -Toolbox
• далее в меню Tools -Additional Controls
• там ищем что-то имеющее в названии ProgressBar и отмечаем его. Жмем Ок.

Теперь в окне Toolbox появится элемент ProgressBar. Просто перетаскиваем его на форму. В свойствах можно задать цвет и стиль отображения полосы прогресса. Останется лишь при необходимости программно показывать форму и задавать для элемента ProgressBar значения минимума и максимума. Примерно это выглядеть будет так:
Практический код
Например, надо обработать все выделенные ячейки. Если форма называется UserForm1, а ProgressBar - ProgressBar1, то код будет примерно такой:

Sub ShowProgressBar()
    Dim lAllCnt As Long
    Dim rc As Range
    'кол-во ячеек в выделенной области
    lAllCnt = Selection.Count
    'показываем форму прогресс-бара
    UserForm1.Show
    UserForm1.ProgressBar1.Min = 1
    UserForm1.ProgressBar1.Max = lAllCnt
    'цикл по всем ячейкам в выделенной области
    For Each rc In Selection
        'прибавляем 1 при каждом шаге
        UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 1
        DoEvents 'чтобы форма перерисовывалась
    Next
    'закрываем форму
    Unload UserForm1
End Sub

Как использовать эту форму и коды
Первоначально надо скачать файл, приложенный к статье, и в свой проект перенести форму frmStatusBar и модуль mCustomProgressBarModule.
Далее просто внедряем нужные строки в свои коды с циклами:

• До начала цикла необходимо вызывать процедуру инициализации формы:
  Call Show_PrBar_Or_No(lAllCnt, "Обрабатываю данные...")
  первым аргументом задается общее кол-во обрабатываемых элементов, а вторым заголовок формы. Если второй аргумент не указан, то по умолчанию будет показан заголовок "Выполнение...". Так же внутри кодов есть кусок кода, отвечающий за минимальное кол-во элементов к обработке. По умолчанию задано 10. Это значит, что если обрабатывается менее 10 ячеек, то форма прогресс-бара показана не будет. Нужно для случаев, когда производятся разные действия над ячейками, но неизвестно сколько их будет. Но зато известно, что с ними будет делать код. Часто для кол-ва ячеек менее 100 нет смысла отображать прогресс выполнения, т.к. это и так секундное дело.
  Чтобы изменить минимальное кол-во достаточно в строке bShowBar = (lCnt > 10) заменить 10 на нужное число.
• Далее в каждом проходе цикла вызвать перерисовку формы под новое значение цикла:
  If bShowBar Then Call MyProgresBar
• и в конце не забыть закрыть форму, чтобы не висела:
  If bShowBar Then Unload frmStatusBar

Пример применения формы:

Sub Test_ProgressForm()
    Dim lr As Long
    Dim lAllCnt As Long 'кол-во итераций
    lAllCnt = 10000
    'инициализируем форму прогресс-бара
    Call Show_PrBar_Or_No(lAllCnt, "Обрабатываю данные...")
    'сам цикл
    For lr = 1 To lAllCnt
        If bShowBar Then Call MyProgresBar
    Next
 
    'закрываем форму, если она была показана
    If bShowBar Then Unload frmStatusBar
End Sub

Так же все описанные примеры и коды можно найти в приложенном файле:
Скачать пример:

  Tips_ShowProgressBar.xls (79,0 KiB, 6 808 скачиваний)

    Видеоуроки

Поиск по меткам