Excel это не сложно

Основные форумы => Вопросы по Excel и VBA => Тема начата: firestarter от 21.11.2020, 00:17:14



Название: Отображение процесса выполнения скрипта
Отправлено: firestarter от 21.11.2020, 00:17:14
Доброго времени суток, добрый люди!
Всем хорошего настроения, здоровья и благополучия!

Хотел просить помощи относительно понимания работы статус/прогресс-бара.
Смотрел тему как работает статус-бар (https://www.excel-vba.ru/chto-umeet-excel/otobrazit-process-vypolneniya/#statusbar).
Искал по форуму и нашел, что прогресс-бар можно применить к циклам (https://www.excel-vba.ru/forum/index.php?topic=3657.0), но у меня в скрипте циклов почти нет; может быть есть в отдельном "кусочке", но он влияет только на небольшую часть документа.

В итоге, использовал форму UserForm из файла примера (Tips_ShowProgressBar.xls) и все, что добился - появление формы с 0% в начале работы скрипта и резкий переход в 100% по окончанию его работы.
Мой скрипт - это т.н. "сборник" кусочков, где есть как записанные макрорекордером простые обработки (скопировать это отсюда туда, применить к скопированному шрифт и т.д.), так и сложные обработки, собранные с просторов интернета, в т.ч. и с данного форума (одна из них (https://www.excel-vba.ru/forum/index.php?topic=6377.new#new)). Каждый кусочек "выделен в блок" (имеет закомментированное примечание), и хотелось бы так и оставить, поскольку работает как надо.

Вот, например, кусочек:

Код: (vb)
' Очистка
    Sheets("2_handler").Select
    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    Range("Таблица1[[Статьи и ниже ФИО]:[Номера]]").Select
    Selection.ClearContents
    Sheets("1-import").Select
    Columns("A:F").Select
    Selection.Delete Shift:=xlToLeft

'   Удалить все листы с результатами кроме "L1" and "L2"
Dim i As Long
Application.DisplayAlerts = False
   For i = Sheets.Count To 1 Step -1
       If Sheets(i).Name <> "L1" Then
           If Sheets(i).Name <> "L2" Then
                Sheets(i).Delete
           End If
       End If
   Next
Application.DisplayAlerts = True

'Путь до файла запроса .iqy
    IQYFile = "D:\link.iqy"
    With ActiveSheet.QueryTables.Add(Connection:= _
       "FINDER;" & IQYFile, Destination:=Range("A1"))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With


И вот хотелось бы, чтобы после каждого такого "кусочка" в форме выполнения скрипта отображался ход в процентах.
Или не в форме, а, например, в нижней части листа - "квадраты и проценты" (из листа примера Tips_ShowProgressBar.xls).
Ну или было хоть какое-то оповещение о ходе выполнения кроме банальных
Код: (vb)
Application.StatusBar = "Ждите, обрабатываю запрос..."
в начале и
Код: (vb)
MsgBox "Готово"
в конце.

Буду рад любой подсказке/помощи/доброму совету.


Название: Re:Отображение процесса выполнения скрипта
Отправлено: Дмитрий Щербаков(The_Prist) от 21.11.2020, 15:14:32
Нельзя прикрутить прогресс-бар к внутреннему процессу Excel. Например, к такому как обновления подключений, пересчет формул и т.п.
Вот здесь еще можно сделать:
Код: (vb)
For i = Sheets.Count To 1 Step -1  
       If Sheets(i).Name <> "L1" Then  
           If Sheets(i).Name <> "L2" Then  
                Sheets(i).Delete  
           End If  
       End If  
   Next

т.к. есть цикл. Что-то вроде:
Код: (vb)
   Const lMaxQuad As Long = 20
   lAllCnt = Sheets.Count
   lr = 0
   For i = Sheets.Count To 1 Step -1
   lr = lr + 1
       If Sheets(i).Name <> "L1" Then  
           If Sheets(i).Name <> "L2" Then  
                Sheets(i).Delete  
           End If  
       End If
       Application.StatusBar = "Удаляю листы: " & Int(100 * lr / lAllCnt) & "%" & String(CLng(lMaxQuad * lr / lAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lr / lAllCnt), ChrW(9633))
       DoEvents
   Next

По сути-то еще в статье про прогресс-бары я писал, что их можно прикрутить везде, где можно воткнуть хоть какой-то счетчик в самом коде. Все зависит от целей и кода. Можно каждый шаг нумеровать общим счетчиком. Например, у Вас 10 блоков. Значит lAllCnt = 10. Внутри самого блока отследить проресс выполнения невозможно, т.к. это некое обновление связей, подключений. Но можно перед каждым блоком увеличивать счетчик(lr = lr +1) и показывать прогресс бар, отталкиваясь именно от этого. При этом можно даже совместить отображение основного процесса(текущего блока) и прогресса внутри него, если это отслеживаемый цикл(вроде как выше - цикл по листам).
Ну вот что-то вроде для примера:
Код: (vb)
    Dim lmain_cnt As Long, lr As Long
    Dim lMainAllCnt As Long, lAllCnt As Long 'кол-во итераций
    Const lMaxQuad As Long = 20 'сколько квадратов выводить
    lAllCnt = 10000
   
    lMainAllCnt = 3 'всего шагов в процедуре
   
    lmain_cnt = 1 'это первый шаг
    Application.StatusBar = "Всего выполнено: " & Int(100 * lmain_cnt / lMainAllCnt) & "%" & String(CLng(lMaxQuad * lmain_cnt / lMainAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lmain_cnt / lMainAllCnt), ChrW(9633))
    DoEvents
    ' Очистка
    Sheets("2_handler").Select
    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    Range("Таблица1[[Статьи и ниже ФИО]:[Номера]]").Select
    Selection.ClearContents
    Sheets("1-import").Select
    Columns("A:F").Select
    Selection.Delete Shift:=xlToLeft
   
   
    lmain_cnt = 2 'это второй шаг - здесь можем отобразить ход выполнения внутри шага
    lAllCnt = Sheets.Count
    lr = 0
    For i = Sheets.Count To 1 Step -1
    lr = lr + 1
        If Sheets(i).Name <> "L1" Then
            If Sheets(i).Name <> "L2" Then
                 Sheets(i).Delete
            End If
        End If
        Application.StatusBar = "Всего выполнено: " & Int(100 * lmain_cnt / lMainAllCnt) & "%" & String(CLng(lMaxQuad * lmain_cnt / lMainAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lmain_cnt / lMainAllCnt), ChrW(9633)) & _
                                ". Удаляю листы: " & Int(100 * lr / lAllCnt) & "%" & String(CLng(lMaxQuad * lr / lAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lr / lAllCnt), ChrW(9633))
        DoEvents
    Next
   
    lmain_cnt = 3 'это третий шаг
    Application.StatusBar = "Всего выполнено: " & Int(100 * lmain_cnt / lMainAllCnt) & "%" & String(CLng(lMaxQuad * lmain_cnt / lMainAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lmain_cnt / lMainAllCnt), ChrW(9633))
    DoEvents
    'Путь до файла запроса .iqy
    IQYFile = "D:\link.iqy"
    With ActiveSheet.QueryTables.Add(Connection:= _
       "FINDER;" & IQYFile, Destination:=Range("A1"))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With
   
   
    'и т.д. по всем шагам
    'очищаем статус-бар от значений после выполнения
    Application.StatusBar = False


Название: Re:Отображение процесса выполнения скрипт
Отправлено: firestarter от 21.11.2020, 15:29:07
Здорово, работает, СПАСИБО!
Это отличное решение - ставить "+1" после каждого шага, это корректно показывает общий процесс выполнения.

Только пара моментов:
У меня эксель 2016 и прогресс-бар - почему-то закрашен темно-зеленым цветом, и прогресса из-за этого почти и не видно. Это можно как-то поменять, чтобы был обычный цвет?
И если Вас не затруднит, скажите пожалуйста, а как это же самое применить к форме "UserForm" (из примера) для заливки серой полосы синим цветом?


Название: Re:Отображение процесса выполнения скрипта
Отправлено: Дмитрий Щербаков(The_Prist) от 21.11.2020, 16:35:48
В случае с 2016 - никак. Можно попробовать сменить цветовую схему(в параметрах Excel), но насколько знаю это не поможет.
К форме сложнее - там можно показать только один из процессов. Т.е. либо только шаги, либо только отдельный цикл. Иначе надо дорабатывать.
Если только для одного процесса - то принцип-то тот же. Задаете общее кол-во шагов lAllCnt, а потом просто вызываете перед каждым шагом форму: Call MyProgresBar
Если шагов меньше 10, то не забудьте в процедуре Show_PrBar_Or_No убрать строку: bShowBar = (lCnt > 10)


Название: Re:Отображение процесса выполнения скрипта
Отправлено: firestarter от 21.11.2020, 19:18:35
Большое спасибо! :)