Vba excel индикатор выполнения программы

Хитрости »

26 Февраль 2016              56340 просмотров

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

Часто при создании кодов в 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

Самый простой вариант отображения процесса выполнения кода. Он может быть без проблем использован на любом ПК.

Application.StatusBar

— это специальный элемент интерфейса, расположенный в левой нижней части окна Excel и который может показывать дополнительную информацию в зависимости от действий пользователя. Все не раз видели его в работе. Например, после того как мы скопировали ячейки StatusBar покажет нам доп.информацию:

И из VBA есть доступ к этому элементу. Чтобы написать слово привет в StatusBar надо выполнить всего одну строку кода:

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
Использование стандартного элемента ProgressBar

Для Userform можно использовать стандартный контрол ProgressBar, но я лично не люблю добавлять на формы элементы, которые надо подключать отдельно. Потому как впоследствии контрол может отказаться работать, т.к. нужной версии не окажется на конечном ПК пользователя. Например в моем офисе 2010 для 64-битных систем его нет.
Поэтому про него кратко и в файле примере его нет. Как его создать:

• создаем 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

Использование своего собственного прогресс-бара

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

Как использовать эту форму и коды
Первоначально надо скачать файл, приложенный к статье, и в свой проект перенести форму 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 153 скачиваний)

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

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



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

I know this is an old thread but I had asked a similar question not knowing about this one. I needed an Excel VBA Progress Bar and found this link: Excel VBA StatusBar. Here is a generalized version that I wrote. There are 2 methods, a simple version DisplaySimpleProgressBarStep that defaults to ‘[|| ] 20% Complete’ and a more generalized version DisplayProgressBarStep that takes a laundry list of optional arguments so that you can make it look like just about anything you wish.

    Option Explicit
    
    ' Resources
    '   ASCII Chart: https://vbaf1.com/ascii-table-chart/
    
    Private Enum LabelPlacement
        None = 0
        Prepend
        Append
    End Enum
    
    #If VBA7 Then
     Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
    #Else
     Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
    #End If
    
    Public Sub Test()
        Call ProgressStatusBar(Last:=10)
    End Sub
    
    Public Sub Test2()
    Const lMilliseconds As Long = 500
    Dim lIndex As Long, lNumberOfBars As Long
    Dim sBarChar As String
        sBarChar = Chr$(133) ' Elipses …
        sBarChar = Chr$(183) ' Middle dot ·
        sBarChar = Chr$(176) ' Degree sign °
        sBarChar = Chr$(171) ' Left double angle «
        sBarChar = Chr$(187) ' Right double angle »
        sBarChar = Chr$(166) ' Broken vertical bar ¦
        sBarChar = Chr$(164) ' Currency sign ¤
        sBarChar = Chr$(139) ' Single left-pointing angle quotation mark ‹
        sBarChar = Chr$(155) ' Single right-pointing angle quotation mark ›
        sBarChar = Chr$(149) ' Bullet •
        sBarChar = "|"
        
        For lIndex = 1 To 10
            Call DisplayProgressBarStep(lIndex, 10, 50, LabelPlacement.Append, sBarChar)
            Call Sleep(lMilliseconds)
        Next
        Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2 Completed")
        Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
    End Sub
    
    Public Sub Test2Simple()
    Const lMilliseconds As Long = 500
    Dim lIndex As Long, lNumberOfBars As Long
        For lIndex = 1 To 10
            Call DisplayProgressBarStep(lIndex, 10, 50)
            Call Sleep(lMilliseconds)
        Next
        Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2Simple Completed")
        Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
    End Sub
    
    ''' <summary>
    ''' Method to display an Excel ProgressBar. Called once for each step in the calling code process.
    ''' Defaults to vertical bar surrounded by square brackets with a trailing percentage label (e.g. [|||||] 20% Complete).
    '''
    ''' Adapted
    ''' From: Excel VBA StatusBar
    ''' Link: https://www.wallstreetmojo.com/vba-status-bar/
    ''' </summary>
    ''' <param name="Step">The current step count.</param>
    ''' <param name="StepCount">The total number of steps.</param>
    ''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
    ''' <param name="LabelPlacement">Optional, Can be None, Prepend or Append. Defaults to Append.</param>
    ''' <param name="BarChar">Optional, Character that makes up the horizontal bar. Defaults to | (Pipe).</param>
    ''' <param name="PrependedBoundaryText">Optional, Boundary text prepended to the StatusBar. Defaults to [ (Left square bracket).</param>
    ''' <param name="AppendedBoundaryText">Optional, Boundary text appended to the StatusBar. Defaults to ] (Right square bracket).</param>
    ''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
    Private Sub DisplayProgressBarStep( _
        lStep As Long, _
        lStepCount As Long, _
        Optional lNumberOfBars As Long = 0, _
        Optional eLabelPlacement As LabelPlacement = LabelPlacement.Append, _
        Optional sBarChar As String = "|", _
        Optional sPrependedBoundaryText As String = "[", _
        Optional sAppendedBoundaryText As String = "]", _
        Optional bClearStatusBar As Boolean = False _
        )
    Dim lCurrentStatus As Long, lPctComplete As Long
    Dim sBarText As String, sLabel As String, sStatusBarText As String
        If bClearStatusBar Then
            Application.StatusBar = False
            Exit Sub
        End If
        
        If lNumberOfBars = 0 Then
            lNumberOfBars = lStepCount
        End If
        lCurrentStatus = CLng((lStep / lStepCount) * lNumberOfBars)
        lPctComplete = Round(lCurrentStatus / lNumberOfBars * 100, 0)
        sLabel = lPctComplete & "% Complete"
        sBarText = sPrependedBoundaryText & String(lCurrentStatus, sBarChar) & Space$(lNumberOfBars - lCurrentStatus) & sAppendedBoundaryText
        Select Case eLabelPlacement
            Case LabelPlacement.None: sStatusBarText = sBarText
            Case LabelPlacement.Prepend: sStatusBarText = sLabel & " " & sBarText
            Case LabelPlacement.Append: sStatusBarText = sBarText & " " & sLabel
        End Select
        Application.StatusBar = sStatusBarText
        ''Debug.Print "CurStatus:"; lCurrentStatus, "PctComplete:"; lPctComplete, "'"; sStatusBarText; "'"
    End Sub
    
    ''' <summary>
    ''' Method to display a simple Excel ProgressBar made up of vertical bars | with a trailing label. Called once for each step in the calling code process.
    '''
    ''' Adapted
    ''' From: Excel VBA StatusBar
    ''' Link: https://www.wallstreetmojo.com/vba-status-bar/
    ''' </summary>
    ''' <param name="Step">The current step count.</param>
    ''' <param name="StepCount">The total number of steps.</param>
    ''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
    ''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
    Private Sub DisplaySimpleProgressBarStep( _
        lStep As Long, _
        lStepCount As Long, _
        Optional lNumberOfBars As Long = 0, _
        Optional bClearStatusBar As Boolean = False _
        )
        Call DisplayProgressBarStep(lStep, lStepCount, lNumberOfBars, bClearStatusBar:=bClearStatusBar)
    End Sub