Прогресс бар excel для макроса - Word и Excel - помощь в работе с программами

Данный прогресс-бар позволяет отображать ход выполнения любого макроса.

Для использования этого индикатора перетащите из файла-примера в свой файл модуль класса ProgressIndicator и форму F_Progress

Использовать прогресс бар сравнительно просто — достаточно добавить в макрос несколько строк кода:

Sub ПростейшийПримерИспользованияПрогрессБара()
    Dim pi As New ProgressIndicator    ' создаём новый прогресс-бар
    pi.Show "Подождите, работает макрос"    ' отбражаем индикатор

    ' здесь код вашего макроса

    pi.Hide    ' закрываем индикатор
End Sub

Sub ПримерИспользованияПрогрессБара()
 
    КоличествоЗапусковВнешнегоМакроса = 3000
 
    Dim pi As New ProgressIndicator    ' создаём новый прогресс-бар
    pi.Show "Форматирование ячеек"    ' отбражаем индикатор

    ' первое действие (на шкале индикатора от 0 до 95 процентов) - это окраска ячеек
    pi.StartNewAction 0, 95, "Окраска ячеек", , , КоличествоЗапусковВнешнегоМакроса
 
 
 
    ' цикл с вызовом внешнего макроса "ФорматированиеЯчейки"
    For i = 1 To КоличествоЗапусковВнешнегоМакроса
 
        ' инициируем очередное действие в индикаторе
        pi.SubAction , "Обрабатывается ячейка $index из $count", "$time"
 
        ' собственно, код цикла
        ФорматированиеЯчейки i
    Next
 
    ' всё покрасили - теперь пора чистить ячейки )
    pi.StartNewAction 95, 100, "Очистка ячеек"
    Cells.Clear
 
    pi.Hide    ' закрываем индикатор
End Sub
 
Sub ФорматированиеЯчейки(ByVal n As Long)    ' вызываемый макрос
    Cells(n).Interior.ColorIndex = 15: Cells(n).BorderAround xlContinuous
End Sub

Давайте рассмотрим подробнее работу с индикатором.

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

Dim pi As New ProgressIndicator    ' создаём новый прогресс-бар

Итак, прогресс-бар создан, и теперь надо его отобразить.

Для этого мы используем метод Show объекта типа ProgressIndicator:

pi.Show "Форматирование ячеек"    ' отбражаем индикатор

При использовании метода Show мы сразу задаём заголовок индикатора (можно здесь указать название вашего макроса)

Индикатор появился на экране — но полоса не отображается, ибо процент выполнения по-умолчанию равен нулю.

Для каждого действия мы будем задавать начальный и конечный процент выполнения задачи

К примеру, если первое действие вашего макроса занимает по времени примерно пятую часть от времени выполнения всего макроса,
то мы укажем интервал для индикатора от 0% до 20%:

Как вы заметили, для запуска очередного действия используется метод StartNewAction объекта ProgressIndicator.

При вызове этого метода можно сразу задать текст для каждой из 3 текстовых строк индикатора:

pi.StartNewAction 0, 20, "Текст первой строки", "Текст строки 2", "Текст строки 3"

Если действие состоит из нескольких отдельных «поддействий», то можно также сразу задать и количество этих «поддействий»

(например, основное действие — это форматирование ячеек (от 0% до 20% индикатора), а поддействия — это окраска отдельных ячеек (первая строка — от 0% до 1% индикатора, вторая строка — от 1% до 2%, и т.д.))

Чтобы нам не мучиться с расчётами этих процентов, мы просто задаём количество действий (например, количество форматируемых ячеек, равное 3000),
и индикатор сам разделит диапазон от 0% до 20% на 3000 равных частей, плавно увеличивая длину полосы индикатора по мере форматирования отдельных ячеек.

 pi.StartNewAction 0, 20, "Окраска ячеек", , , 3000

Чтобы уведомить индикатор об очередном «поддействии» внутри цикла, мы используем метод SubAction объекта ProgressIndicator

' инициируем очередное действие в индикаторе
        pi.SubAction , "Обрабатывается ячейка $index из $count", "$time"

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

В этом случае (если значения некоторых из 3 строк индикатора не заданы), эти строки не изменяются
(в первой строке индикатора останется текст, заданный ранее при использовании метода StartNewAction)

Кроме того, в тексте для строк индикатора можно использовать следующие ключевые слова:

$index и $count — для вывода строк типа «Обрабатывается ячейка 515 из 3000«,
$time — для вывода ожидаемого времени до окончания макроса

(макрос анализирует текущий процент выполнения и затраченное время, и предсказывает, сколько времени осталось до окончания всех действий)

Если же необходимо просто увеличить длину полоски индикатора — можете использовать метод SubAction без параметров:

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

Вполне допустим следующий код:

    pi.StartNewAction 5, 20, "Действие 1"    ' начинаем не с нуля
    pi.StartNewAction 20, 50, "Действие 2"    ' начинается сразу после предыдущего
    pi.StartNewAction 35, 60, "Действие 3"    ' начинается раньше предыдущего
    pi.StartNewAction 85, 90, "Действие 4"    ' начинается через время после предыдущего
    pi.StartNewAction 10, 100, "Действие 5"    ' начинаем почти всё сначала

По окончании макроса желательно закрыть прогресс бар:

pi.Hide    ' закрываем индикатор

У объекта ProgressIndicator имеется много различных свойств и методов.

Вкратце расскажу о некоторых свойствах:

свойство Caption позволяет задать новый заголовок индикатора
свойство FP позволяет получить доступ к отображаемой форме (и всем её элементам управления)
(например, код pi.FP.PrintForm выведет индикатор на печать)
свойства Line1, Line2 и Line3 позволяют в любом месте кода задать текст конкретной строки индикатора
свойства ShowPercents и ShowTime включают или выключают отображение процента выполнения и времени в заголовке индикатора
(по умолчанию оба свойства имеют значение TRUE, т.е. в заголовке отображается и время, и процент выполнения макроса)

Из функций объекта мы рассмотрим только одну: AddChildIndicator

Эта функция создаёт дочерний прогресс бар, и отображает его выше или ниже родительского:

' создаём дочерний индикатор, и выводим его ниже основного
    Dim pi2 As ProgressIndicator
    Set pi2 = pi.AddChildIndicator("Раскрашивание ячеек", 1)

При изменении процента выполнения в дочернем индикаторе пропорционально меняется и процент выполнения главного (родительского) прогресс-бара.

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

На индикаторе присутствует кнопка «Отмена» — её нажатие вызывает останов всех запущенных макросов
(выполняется команда End, останавливающая все макросы, и обнуляющая все переменные)

Поскольку у этой кнопки свойство Cancel установлено в TRUE, нажатие на клавиатуре клавиши ESC равносильно нажатию кнопки «Отмена»
(при нажатии Esc макрос останавливается)

добавлено 23.02.2012

Новая версия прогресс-бара — с поддержкой отображения лога на индикаторе, и возможностью отображения лога в виде текстового файла.

Высоту текстового поля с логом можно изменять:

Новая версия индикатора, и примеры его использования — во втором прикреплённом файле.

PS: Идеальный прогресс-бар должен работать так

115771 просмотр

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Источник

Хитрости »

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

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

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

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

Видеоуроки

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

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

Источник

caustic

19 / 19 / 0

Регистрация: 30.09.2011

Сообщений: 283

26.12.2012, 13:14. Показов 6284. Ответов 10

Метки нет (Все метки)

Добрый день!

почитал соседние темки на эту тему, нашел у товарища analyst архив с замечательными формами ProgressBar

но так как в первый раз вообще с этим сталкиваюсь, подскажите пожалуйста, как в принципе внедрить представленный ProgressBar (желательно с заполнющейся кубиками строкой, что в приложении) для какого-либо макроса.

например для этого:

Данный макрос отменяет объединение ячеек и дублирует значение из первой ячейки до тех пор, пока не наткнется на новое.

Visual Basic

Application.ScreenUpdating = False
    Selection.UnMerge
    AreaCount = Selection.Areas.Count
    If AreaCount <= 1 Then
        ColumnCount = Selection.Columns.Count
        RowCount = Selection.Rows.Count
        For j = 1 To ColumnCount
            LastValue = " "
            For k = 1 To RowCount
             If (IsEmpty(Selection.Cells(k, j).Value) = True Or Len(Trim(Selection.Cells(k, j).Value)) = 0) Then
              Selection.Cells(k, j).Value = LastValue
             Else
              LastValue = Selection.Cells(k, j).Value
             End If
            Next k
        Next j
    Else
        For i = 1 To AreaCount
            ColumnCount = Selection.Areas(i).Columns.Count
            RowCount = Selection.Areas(i).Rows.Count
            For j = 1 To ColumnCount
            LastValue = " "
            For k = 1 To RowCount
             If (IsEmpty(Selection.Areas(i).Cells(k, j).Value) = True Or Len(Trim(Selection.Areas(i).Cells(k, j).Value)) = 0) Then
              Selection.Areas(i).Cells(k, j).Value = LastValue
             Else
              LastValue = Selection.Areas(i).Cells(k, j).Value
             End If
            Next k
        Next j
        Next i
    End If
    Application.ScreenUpdating = True

Вложения

ModelessForms.rar (42.8 Кб, 31 просмотров)

15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

26.12.2012, 14:23

Что касается этого макроса — его надо переписать с использованием массивов или формул, скорость работы увеличится в 20-40 раз, и прогрессбар не потребуется
Кстати, если диапазон объединенных ячеек занимает более одного столбца, то все столбцы после первого заполняются пробелом — это так должно быть?

19 / 19 / 0

Регистрация: 30.09.2011

Сообщений: 283

26.12.2012, 15:39

[ТС]

Сообщение от Казанский

нет, все столбцы заполняются значениями по той же методе (если же конечно они имеют объединенные ячейки), или же значение остается неизменным.

по поводу прогресс бара — макрос этот привел в качестве примера. мне бы просто разобраться. пусть даже на стандартном ProgressBar (Microsoft ProgressBar Control, v 6.0), как что где подключается, чтоб он работал при выполнении какого нить примитивного макроса там.. закраска красным ячеек через одну…

Скрипт

5468 / 1148 / 50

Регистрация: 15.09.2012

Сообщений: 3,514

26.12.2012, 16:19

Работа с ProgressBar

Отображение ProgressBar на панели Toolbox:

щ. правой кн. мыши по Toolbox — Additional Controls…;
Microsoft ProgressBar Control, версия.

Код, который показывает принцип работы ProgressBar:

Кликните здесь для просмотра всего текста

Visual Basic

Private Sub CommandButton1_Click()
    
    'Задаём начальное и конечное значения "ProgressBar".
    Me.ProgressBar1.Min = 1
    Me.ProgressBar1.Max = 1000
    
End Sub
 
Private Sub CommandButton2_Click()
 
    Dim i As Long
 
    For i = 1 To 1000 Step 1
        'Устанавливаем значение в "ProgressBar",
        'что меняет количество кубиков в "ProgressBar".
        Me.ProgressBar1.Value = i
    Next i
    
End Sub

19 / 19 / 0

Регистрация: 30.09.2011

Сообщений: 283

27.12.2012, 13:24

[ТС]

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

Добавлено через 1 минуту
или как я сам понял, что я внедряю в свой макрос строчки Me.ProgressBar1.Min = … — со значением по нарастающей.

Скрипт

5468 / 1148 / 50

Регистрация: 15.09.2012

Сообщений: 3,514

27.12.2012, 14:02

Код показывает, в скольких ячейках уже занесено число «1»:

Кликните здесь для просмотра всего текста

Visual Basic

Private Sub CommandButton1_Click()
    
    Dim lEffort As Long
    Dim i As Long
    
    'Узнаём, сколько ячеек нужно обработать.
    'Допустим нужно обработать 10000
    lEffort = 10000
    
    Me.ProgressBar1.Min = 1
    Me.ProgressBar1.Max = lEffort
    
    For i = 1 To lEffort Step 1
        Cells(i, "A").Value = 1
        'Т.е. "ProgressBar" показывает, сколько ячеек уже обработано.
        Me.ProgressBar1.Value = i
    Next i
    
End Sub

Модератор

34709 / 19230 / 4040

Регистрация: 12.02.2012

Сообщений: 32,197

Записей в блоге: 13

30.12.2012, 12:02

А хотите вот такой progress-bar?
(Откройте прилагаемый файл — в главном меню пункт «Прогресс-Бар». Нажмите «Заполнить»…)

17993 / 7619 / 890

Регистрация: 25.12.2011

Сообщений: 11,352

Записей в блоге: 17

04.01.2013, 01:51

Сообщение было отмечено как решение

Решение

Или на Label-е.

Модератор

34709 / 19230 / 4040

Регистрация: 12.02.2012

Сообщений: 32,197

Записей в блоге: 13

04.01.2013, 18:43

Думаю, на Label-е лучше (во всяком случае, проще). Последнее время сам примерно такими пользуюсь.

282 / 6 / 0

Регистрация: 01.07.2012

Сообщений: 46

04.01.2013, 22:42

А вот еще примеры. В нете нашел.

3217 / 966 / 223

Регистрация: 29.05.2010

Сообщений: 2,085

04.01.2013, 22:58

Я давно пользуюсь таким вариантом:

IT_Exp Эксперт 87844 / 49110 / 22898 Регистрация: 17.06.2006 Сообщений: 92,604	04.01.2013, 22:58
11

Источник

kolevchuk

Пользователь

Сообщений: 42
Регистрация: 03.03.2016

05.04.2018 11:58:33

Код

Sub Размножить()
    Dim lngCalc As Long
    Dim n&
    n = Val(InputBox("n ="))
     
    Application.ScreenUpdating = False
    lngCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
     
    Range("g1:h1").Copy Range("g2:h2").Resize(1 * n)
     
    Application.ScreenUpdating = True
    Application.Calculation = lngCalc
    Application.DisplayAlerts = True
    MsgBox "Готово!", vbInformation
End Sub

Дмитрий Щербаков Пользователь Сообщений: 14182 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office	В этот никак. Смысла нет. Прогресс-бары внедряются в циклы, а у Вас только одна рабочая строка. Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

kolevchuk Пользователь Сообщений: 42 Регистрация: 03.03.2016	Дмитрий Щербаков, можно написать и через цикл, но тогда увеличится время работы макроса.

Jack Famous Пользователь Сообщений: 10852 Регистрация: 07.11.2014 OS: Win 8.1 Корп. x64 \| Excel 2016 x64: \| Browser: Chrome	Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Dima S Пользователь Сообщений: 2063 Регистрация: 01.01.1970	какой прогрессбар вы рассчитываете увидеть для этого макроса?)

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

05.04.2018 12:26:10

kolevchuk, какой смысл в прогрессбаре в Вашем случае? Всего одна операция, Вы только моргнуть успеете.

Цитата
kolevchuk написал: увеличится время работы макроса

А прогрессбар всегда будет увеличивать время.

kolevchuk Пользователь Сообщений: 42 Регистрация: 03.03.2016	Dima S, хотя бы, количество пройденных строк.

Nordheim

Пользователь

Сообщений: 3154
Регистрация: 18.04.2017

05.04.2018 12:29:13

Цитата
Юрий М написал: Вы только моргнуть успеете

Не, не успеет

«Все гениальное просто, а все простое гениально!!!»

kolevchuk Пользователь Сообщений: 42 Регистрация: 03.03.2016	Юрий М, операция повторяется до 1 000 000 раз.

Юрий М Модератор Сообщений: 60588 Регистрация: 14.09.2012 Контакты см. в профиле

Пытливый

Пользователь

Сообщений: 4587
Регистрация: 22.12.2012

#11

05.04.2018 12:32:15

Извините великодушно, а какой смысл в прогрессбаре после этой инструкции:

Код
Application.ScreenUpdating = False

Кому решение нужно — тот пример и рисует.

Дмитрий Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#12

05.04.2018 12:33:56

Цитата
kolevchuk написал: операция повторяется до 1 000 000 раз

какая именно? Я, видимо, слишком мало смыслю в программирование, чтобы увидеть эти повторы. Носом не ткнете?

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

kolevchuk Пользователь Сообщений: 42 Регистрация: 03.03.2016	Пытливый, в исходном коде она нужна, с прогресс баром нет, к чему этот вопрос?

kolevchuk

Пользователь

Сообщений: 42
Регистрация: 03.03.2016

#14

05.04.2018 12:36:33

Дмитрий Щербаков,

Код
Range("g1:h1").Copy Range("g2:h2").Resize(1 * n)

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

#15

05.04.2018 12:37:41

Цитата
kolevchuk написал: к чему этот вопрос?

А к тому, что Вы показываете код, к которому хотите прикрутить прогрессбар.

Anchoret Пользователь Сообщений: 1062 Регистрация: 01.01.1970 Anchoret	kolevchuk,чтобы увидеть какая строка обрабатывается и для прогресс-бара нужен цикл.

Dima S

Пользователь

Сообщений: 2063
Регистрация: 01.01.1970

для того чтобы показать прогресс — нужно знать время выполнения операции или количество циклов.
тогда текущий прогресс = пройдено времени(циклов)/общее время(к-во циклов)*100%.
в вашем случае если говорить о времени — общее неизвестно, можете отобразить только пройденное время.
если о количестве скопированных строк — неизвестно сколько уже скопировано в данный момент.
Далее у вас используется Application.ScreenUpdating, что не даст обновить информацию о статусе, а если отключить — замедлит выполнение операции.
Короче — в вашем случае статусбар не имеет смысла.
Разве что проведите тестовое копирование, замерьте время и перед началом сделайте

~~MsgBox~~

Application.StatusBar = «Операция займет приблизительно 10 минут, можете сходить попить кофе»

Изменено: Dima S — 05.04.2018 12:44:38

kolevchuk Пользователь Сообщений: 42 Регистрация: 03.03.2016	Anchoret, посоветуйте, пожалуйста, как это сделать в цикле.

Юрий М Модератор Сообщений: 60588 Регистрация: 14.09.2012 Контакты см. в профиле	А это уже вопрос не по теме.

Jack Famous

Пользователь

Сообщений: 10852
Регистрация: 07.11.2014

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#20

05.04.2018 12:45:09

Цитата
kolevchuk написал: как это сделать в цикле

читали бы ответы — не возникло бы вопроса… #4

Господа — вы должны

это

видеть добавлю в анекдоты))

Изменено: Jack Famous — 05.04.2018 12:53:10

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Nordheim Пользователь Сообщений: 3154 Регистрация: 18.04.2017	Зачем зацикливать один и тот же код, в чем идея? Посмотреть как работает прогресс бар? Возьмите Уокенбаха, сделайте как в книге написано и наслаждайтесь «Все гениальное просто, а все простое гениально!!!»

Дмитрий Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#22

05.04.2018 13:15:00

Цитата
kolevchuk написал: как это сделать в цикле

для начала СДЕЛАЙТЕ ЦИКЛ. Пока кроме Вам никто не понимает что Вы вообще хотите в цикле сделать и главное — зачем?
Вот Вам примеры — выбирайте:

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

Изменено: Дмитрий Щербаков — 05.04.2018 13:15:39

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

Источник

Создание прогресс-бара выполнения макроса (Макросы/Sub)

Смотрите также ‘показывать’ в Application.StatusBar
прорисовывать элементы с в и Delphi,Прогресс бар ?
Dim pi As
Application.Calculation = xlCalculationManual инете представлено достаточно Удалите одну - :=False, Transpose:=False Excel.WorkbookAlex_ST, 23.12.2016 в ChrW(9633)) в первом посте)? String(11 - pApplication.StatusBar = False UserForm1.Show Viper25alex_gearbox использованием манифеста винды. это не проблема, Может я чего-то New ProgressIndicator ' For i = много вариаций создания и все заработает Workbooks(Month + "_TEMP.xlsx").Close Set Gorod = 14:08, в сообщении DoEvents
Alex_ST
10, ChrW(8700))
End Sub

UserForm1.Label1.Width = 1: Здравствуйте.: А я сделал
blanks тока как мне не понимаю.. Но создаём новый прогресс-бар 10 To 109 Progressbar, но какViper25 Application.ScreenUpdating = True ThisWorkbook № 9 ()Next : Это точно. ЯApplication.StatusBar = "Выполнено: Sub test2()For i = Нужно создать прогресс-бар ProgressBar в StatusBar-е : Как в ескселе это окно "вклеить"

 какой смысл в pi.Show «Подождите, работаетIf Cells(i, 1).Value его прописать? В: Увы. Что яApplication.CutCopyMode = True

’Вставляем таблицу 1 200?’200px’:»+(this.scrollHeight+5)+’px’);»>Спасибо, Слава.’очищаем статус-бар от отходил от компа » & p

For i = 1 To 100 для наглядности работы Excel-я. На API-шных
сделать пргресс бар в файл Экселевский, прогресс баре, еслимакрос" ' отбражаем = "" Then идеале хотелось, чтобы не так сделал?Application.DisplayAlerts = True Dim filenameTEMP AsUdik значений после выполнения и не успел & "% " 1 To 10000 UserForm1.Label1.Width = Int(i макроса. вызовах. Могу прислать. по типу как если это возможно. отключено обновление экрана? индикатор ' код Rows(i).RowHeight = 0 Progressbar выглядел аналогично Спасибо.End Sub String: ага, увиделApplication.StatusBar = False сам ответить. & S: DoEvents p = i * j) Нашел такой пример. Если кому интересно: копирование файла, И можно лиЛина макроса Application.ScreenUpdating ='For Each cc с тем, которыйStarbirstFunction GetFolderPath(Optional ByValfilenameTEMP = myPathViper25End Sub Спасибо, Слава.Next 100For k = 200?'200px':''+(this.scrollHeight+5)+'px');">Sub Progress() http://j-walk.com/ss/excel/tips/tip34.htm т.е. движущиеся по остановить выполнение макроса. : Вот файл False Range("B22".Select Selection.AutoFill In [B10:B109].Columns появляется при нажатии: Доброго времени суток! title As String + "" +: взял тут, тамAlex_STApplication.StatusBar = FalseApplication.StatusBar = "Выполнено: 1 To 100000 ' -=Dj=- мере выполнения кода Alex77755Sanja Destination:=Range("B2200", Type:=xlFillDefault Range("B2200".Select'cc.EntireColumn.Hidden = cc.Text на кнопку PDF. Ребята, окажите, пожалуйста, = "Выберите папку", Month + "_TEMP.xlsx" SLAVICK достаточно много вариантов: Вызов своих процедурEnd Sub " & p Next k ' Progress Bar: Здравствуйте! помогите с

 квадратики???: Нет в стандартном: А Вы все

 Range(«B201201».Select Selection.AutoFill Destination:=Range(«B201400», = «» Особо в макросах помощь! Во вложенном Optional ByVal initialPathn = n, спасибо. и с ЮзерФорм вставляйте между DoEventsSub test5()

 & «% «DoEvents’ прогресс баром (можноvlth

 — кто мешает по инструкции сделали? Type:=xlFillDefault Range(«B201400».Select Range(«E2».Select’Next не волоку. Спасибо
файле имеется кнопочка

 As String = + 1 /Viper25 тоже

 и NextFor i = & String(p NextDim intIndex As

 и статус бар).: Щёлкни правой клавишей shock

 нажать кнопочку? Если прогрессбар именно
ActiveCell.FormulaR1C1 = «1»Next всем отозвавшимся!
"С К Р "P:ФинДирОтделКонсолидацииБюджет") As String 2: p = :SLAVICK Udik 1 To 10000 10 + 1, End Sub IntegerУ меня есть по панели 'элементыДля остановки процесса , то: Selection.AutoFill Destination:=Range("E2:E400", Type:=xlFillDefaultApplication.Calculation = xlCalculationAutomaticStarbirst Ы Т ЬDim PS As 2 * nSLAVICK : для конкретного файла : У меня лично p = i ChrW(10000 + p Viper25 Dim sngPercent As
большой макрос, записанный управления’: в тело поставитьв Вашем файле

 Range(«E2:E400».Select Range(«C1».Select ‘DimApplication.ScreenUpdating = True: Прилагаю отредактированный файл. П У С
String: PS =Application.StatusBar = "Выполнено:, по Вашему примеру - нужно добавить не получается ничего 100: S 2)): Single

 макрорекордером, выполняющий последовательные->Additional Controls…->Microsoft ProgressBar DoEvents и проверку их нет rng As RangeEnd SubФормуляр
Т Ы Е Application.PathSeparator » & n
создал макрос, который
4е раза строки: показать в статусбаре = String(p DoEvents Udik Dim intMax As действия больше минуты.
 Control глобальной переменной.Лина With ThisWorkbook.Worksheets(«раскрой двп».Range(«C:C»Формуляр
beer

: Честно говоря, код Я Ч Е

With Application.FileDialog(msoFileDialogFolderPicker) * 100 & работает в простом200?’200px’:»+(this.scrollHeight+5)+’px’);»>n = n +

 при отключенном ScreenUpdating 10, ChrW(9632)) &Next, а как его IntegerМожно добавить вМожно почти то
Глобальнюу переменную менять: А как это Set Rng =: Но если очень
выглядит для меня Й К И».If Not Right(initialPath, «% » &
примере. 1 / 4: Alex_ST String(11 - p Application.StatusBar = False внедрить в мой intMax = 100 него прогресс бар же самое сделать по другой кнопке сделать? .Find(0, , LookIn:=xlValues, хочется прогресс-бар - довольно бессмысленным, При нажатии на 1) = PS String(p, ChrW(8700)): DoEvents Открывает файл "12_TEMP.xlsx", p = 4 : Странно... 10, ChrW(9633)) End Sub файл (в примере)?For intIndex = для видимости выполнения. самому из 2хAma Юрий М lookat:=xlWhole) If Not держите.но если вынести эту кнопочку срабатывает Then initialPath =Workbooks.Open Filename:=filenameTEMP, UpdateLinks:=False берет данные и * n sboy Application.StatusBar = "Выполнено: Sub test3()Udik 1 To intMax (Проблема заключается в Labels. : Дело в том: , а цитировать Rng Is NothingБез изысков. за границы основного макрос, который скрывает initialPath & PSWorkbooks(Month + "_TEMP.xlsx").Worksheets("1").Range("A2:C10").Copy вставляет в файл Application.StatusBar = "Выполнено:: Добрый день. " & pFor i =: Модуль формы скопировать sngPercent = intIndex том что действия Для этого нужно что у меня зачем? Вы можете Then Do Rng.EntireRow.Delete Starbirst цикла пустые строки в .ButtonName = "Выбрать": Gorod.Worksheets("ALL").Range("A2:C10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, "ALL". " & nЯ тоже пользуюсь & "% " 1 To 10000 сначала, потом в / intMax не циклические и установить Label.Caption='', одну стоит Office 2007 просто Set Rng =: ГЕНИАЛЬНО! 200?'200px':''+(this.scrollHeight+5)+'px');">Application.ScreenUpdating = False диапазоне A10:A109 и .title = title: SkipBlanks _Но если добавляю * 100 & статусбаром, вот этот & S: DoEventsp = i обычный модуль кодProgressStyle1 sngPercent, chkPg1Value.Value все примеры которые из надписей

 и в ActiveXотвечать .FindNext() Loop WhileМоих познаний Excel,Application.Calculation = xlCalculationManual
столбец B в .InitialFileName = initialPath:=False, Transpose:=False
еще один блок
«% » &
больше всего нравитсяNext

 100: S процедуры.DoEvents
я находил не

excelworld.ru

Progressbar к существующему макросу (Макросы/Sub)

(‘фоновую’) сделать постоянной есть ProgressBar 6.0(SP4)? Not Rng Is не говоря уже…. диапазоне , еслиIf .Show <>Workbooks(Month + «_TEMP.xlsx»).Close «‘Вставляем таблицу 2″, String(p, ChrW(8700)): DoEvents200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub StatusBar3()Application.StatusBar = False = «»: ForAlex_ST’———————— подходят) ширины, а шириной и ProgressBar 5.0(SP2)Ama Nothing End If про макросы, недостаточно,Application.ScreenUpdating = True в списке нет -1 Then Exit’Вставляем таблицу 2 макрос ругается.SLAVICKDim lr AsEnd Sub j = 10102: Вообще-то очень удобно’ Your codenilem другой какой выбрать. Просто: Доброе время суток!!! End With For потому понять, чтоApplication.Calculation = xlCalculationAutomatic данных (элемент управления FunctionDim filenameTEMP As200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub SBOR(): так LongОбсуждалось на Планете To 10102 + прогресс в статус-баре

 would go here:

необходимо управлять программно. я ее буду Есть файл экселевский, Each cell In
такое цикл, какработать будет, наверняка, «список» для выбора
GetFolderPath = .SelectedItems(1) String Application.ScreenUpdating = False ScreenUpdating Dim lAllCnt As
Udik p 10:
показывать.’————————
-=Dj=- Цвет фона надписей, тестить на работе
с VBA. В Sheets(«раскрой двп».Range(«A2200» cell.Formula его задать, мне быстрее.
формы в текущем
If Not Right(GetFolderPath,
filenameTEMP = myPathApplication.CutCopyMode = False
, и
Long ‘кол-во итераций
: Так обычно обновления
S = SВот у меня
Sleep 100, привет само-собой, должен быть
а там XP котором создаются листы
= cell.Value Next достаточно сложно понять.
Может и прогрес-бар
файле) . В
1) = PS
+ «» +
Application.DisplayAlerts = False

DisplayStatusBarConst lMaxQuad As экрана отрубают & ChrW(j): Next
в заначке лежит

Nextможет лучше статус-бар? hands разным. а у меня с данными с cell pi.Hide ‘ Я брал разные не понадобится… представленной таблице работа Then GetFolderPath = Month + «_TEMP.xlsx»’задаем путь к- это разные Long = 20SLAVICKApplication.StatusBar = «Выполнено:

excelworld.ru

VBA Прогресс бар

 несколько примеров:End SubПросто вставьте вПолучаем ‘непрерывный’ (без
Win7. помощью макроса. Хочу закрываем индикатор’ End макросы, пытался что-тоPS: Объявлять переменную макроса не занимает GetFolderPath & PSn = n данным вещи. ‘сколько квадратов выводить: Обновление экрана со » & p200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub test1()Но не получается. нужных местах в квадратиков-сегментов) Progress Bar.А DoEvents куда при выполнении вывести Sub изобрести — так в цикле тоже много времени, однакоEnd With + 1 /Dim myPath AsКонечно если выlAllCnt = 10000 статус баром не & «% «For i =Помогите, плиз. кодеУдачи! вставлять? В исполняемый

 окно с ProgressBar-омThe_Prist и получился макрос, как-то не принято. в настоящей таблице,End Function 2: p = String

 его спрятали, тоFor lr = связано — действительно
& S: DoEvents
1 To 10000Спасибо.Application.StatusBar = «Происходит этапS_Isa макрос?

 чтобы показывало степень: Лина, читать код

 который я применялА внутренний цикл там, где помимоSLAVICK 2 * n
myPath = GetFolderPath и не увидите.:

 1 To lAllCnt самый удобный способNext

p = iUdik №1″‘ следующий -: А может вполнеanalyst выполнения макроса, а

planetaexcel.ru

ProgressBar в VBA

 совершенно неудобно. Сами по сей день. по одному столбц столбцов A, B,: так Вы жеApplication.StatusBar = «Выполнено:’Задаем часть имениВот см так:Application.StatusBar = «Выполнено: — статусбар. иApplication.StatusBar = False 100: ну вот пример этап № 2. достаточно StatusBar?: Можно здесь глянуть: так же хочу гляньте. Исправьте, пожалуйста,
Спасибо большое! B никакого эффекта и С имеются смотрите на что » & n файла — номер200?’200px’:»+(this.scrollHeight+5)+’px’);»>Public Sub d()
» & Int(100 не нужно никаких

End SubApplication.StatusBar = «Выполнено: простенький 3 и т.д.
И ну егоУведомление в процессе добавить кнопку остановки применив теги кода.
Лина не даёт.

 формулы в других он ругается, и * 100 & месяцаApplication.ScreenUpdating = 0 * lr / юзерформ. Код работаетSub test4() » & p200?’200px’:»+(this.scrollHeight+5)+’px’);»>а в конце к лешему лишние выполнения макроса
выполнения. Трабл в Это кнопочка чуть: Доброго времени суток.

И что остаётся? столбцах, требует значительного
что пишет. «% » &

Dim Month AsApplication.StatusBar = «111111: lAllCnt) & «%» сразу одинаково уFor i =
& «% «Public Sub test()КодApplication.StatusBar = «»

CyberForum.ru

Создание графического прогрессбара в Excel

 формы!Ama том что в выше поля, где Уважаемые знатоки нужна
Код200?’200px’:»+(this.scrollHeight+5)+’px’);»>Public Sub Скрыть() времени. Каким образомУ Вас дважды

 String(p, ChrW(8700)): DoEvents String » ‘:DoEvents & String(CLng(lMaxQuad *
всех. 1 To 10000
& String(p Dim i As-=Dj=-А отражение ‘прогресса’
: С этим разобрался. стандартном наборе элементов набираете сообщение.
ваша помощь.Dim i As можно отобразить процесс
в дном макросеWorkbooks.Open Filename:=filenameTEMP, UpdateLinks:=FalseMonth = Application.InputBox(«ВведитеApplication.ScreenUpdating = 1
lr / lAllCnt),Viper25
p = i

 10 + 1, Integer, j As:
вполне можно сформировать благодарю. В макросе в VBA ProgressBara
Alexander88Не получается прилепить Integer работы макроса? Как повторяется строка:Workbooks(Month + «_TEMP.xlsx»).Worksheets(«2»).Range(«A2:C10»).Copy

 номер месяца», Type:=2)Application.StatusBar = False ChrW(9632)) & String(lMaxQuad: Подскажите, как прогресс-бар 100: S

ChrW(8700))
Double, k&

CyberForum.ru

Прогресс бар выполнения макроса без цикла (Макросы/Sub)

nilem в текстовой переменной обрабатывал глобальную переменную нету.
: Приложите файл-пример, помогут к прогресс баруDim cc добавить к макросу
200?’200px’:»+(this.scrollHeight+5)+’px’);»>Dim filenameTEMP As StringGorod.Worksheets(«ALL»).Range(«A12:C20»).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,’Задаем имя отчета
End Sub — CLng(lMaxQuad * внедрить в мой = String(p DoEventsj = UserForm1.Width

, такой вариант подойдет, которую в нужные .Можно окно создать
быстрее
макрос, выдает ошибку.Application.ScreenUpdating = False простейший Progressbar? В
а это недопустимо. SkipBlanks _Dim Gorod AsЦитата
lr / lAllCnt),
файл (в примере

 10, ChrW(10152)) &Next / 100 спасибо) моменты в алгоритме

excelworld.ru

А есть возможность

Источник