Форум программистов, компьютерный форум, киберфорум
VBA
Форум программистов и сисадминов Киберфорум > Форум программистов > Basic > VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  
 
2 из 2 « 1 2
 
Рейтинг 4.50/18: Рейтинг темы: голосов - 18, средняя оценка - 4.50
0 / 0 / 0
Регистрация: 03.08.2022
Сообщений: 10
Excel

Progress Bar

21.11.2022, 16:48. Показов 4585. Ответов 27
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
Добрый день.
Имеется макрос, достаточно объемный. Вычисляет и вносит в определенные ячейки рабочего листа значения с пользовательской формы и с соседнего листа. По времени занимает секунд 7. Есть ли возможность отразить выполнение данного макроса с помощью Progress Bar ? Имеется множество вариантов создания формы Progress Bar. Однако, вызывает трудность связать Progress Bar с исполняемым макросом.

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

Sub Данные()
 
 
Sheets("Исходные данные").Select
 
   If MsgBox("Проверьте, правильно ли выбрали строку. Внести данные в ДКП?", vbYesNo) <> vbYes Then Exit Sub
   
 i = ActiveCell.Row
     
Sheets("Договор").Select
' Присваиваем значения нашим ячейкам, по именам которые мы задавали
    Range("number").Value = Sheets("Исходные данные").Cells(i, 1).Value
    Range("datazakl").Value = Sheets("Исходные данные").Cells(i, 2).Value
    Range("fio").Value = Sheets("Исходные данные").Cells(i, 3).Value
    Range("reg").Value = Sheets("Исходные данные").Cells(i, 4).Value
    Range("rayon").Value = Sheets("Исходные данные").Cells(i, 5).Value
    Range("adres").Value = Sheets("Исходные данные").Cells(i, 6).Value
    Range("seria").Value = Sheets("Исходные данные").Cells(i, 7).Value
    Range("pasnumber").Value = Sheets("Исходные данные").Cells(i, 8).Value
    Range("vydan").Value = Sheets("Исходные данные").Cells(i, 9).Value
    Range("datavyd").Value = Sheets("Исходные данные").Cells(i, 10).Value
    Range("fiodover").Value = Sheets("Исходные данные").Cells(i, 11).Value
    Range("dover").Value = Sheets("Исходные данные").Cells(i, 12).Value
    Range("dataresh").Value = Sheets("Исходные данные").Cells(i, 13).Value
    Range("celzag").Value = Sheets("Исходные данные").Cells(i, 14).Value
    Range("kvartal").Value = Sheets("Исходные данные").Cells(i, 15).Value
    Range("del").Value = Sheets("Исходные данные").Cells(i, 16).Value
    Range("uchastok").Value = Sheets("Исходные данные").Cells(i, 17).Value
    Range("vydel").Value = Sheets("Исходные данные").Cells(i, 18).Value
    Range("lesn").Value = Sheets("Исходные данные").Cells(i, 19).Value
    Range("plas").Value = Sheets("Исходные данные").Cells(i, 20).Value
    Range("plas1").Value = Sheets("Исходные данные").Cells(i, 21).Value
    Range("fornumber").Value = Sheets("Исходные данные").Cells(i, 23).Value
    Range("dataokzag").Value = Sheets("Исходные данные").Cells(i, 24).Value
    Range("spodr").Value = Sheets("Исходные данные").Cells(i, 25).Value
    Range("kolpodr").Value = Sheets("Исходные данные").Cells(i, 26).Value
    Range("dataoch").Value = Sheets("Исходные данные").Cells(i, 27).Value
Sheets("Прил1").Select
    Range("datazakl1").Value = Sheets("Исходные данные").Cells(i, 1).Value
    Range("skr").Value = Sheets("Исходные данные").Cells(i, 30).Value
    Range("ssr").Value = Sheets("Исходные данные").Cells(i, 31).Value
    Range("smr").Value = Sheets("Исходные данные").Cells(i, 32).Value
    Range("sd").Value = Sheets("Исходные данные").Cells(i, 33).Value
    Range("sdr").Value = Sheets("Исходные данные").Cells(i, 34).Value
    Range("ekr").Value = Sheets("Исходные данные").Cells(i, 38).Value
    Range("esr").Value = Sheets("Исходные данные").Cells(i, 39).Value
    Range("emr").Value = Sheets("Исходные данные").Cells(i, 40).Value
    Range("ed").Value = Sheets("Исходные данные").Cells(i, 41).Value
    Range("edr").Value = Sheets("Исходные данные").Cells(i, 42).Value
    Range("bkr").Value = Sheets("Исходные данные").Cells(i, 46).Value
    Range("bsr").Value = Sheets("Исходные данные").Cells(i, 47).Value
    Range("bmr").Value = Sheets("Исходные данные").Cells(i, 48).Value
    Range("bd").Value = Sheets("Исходные данные").Cells(i, 49).Value
    Range("bdr").Value = Sheets("Исходные данные").Cells(i, 50).Value
    Range("okr").Value = Sheets("Исходные данные").Cells(i, 54).Value
    Range("osr").Value = Sheets("Исходные данные").Cells(i, 55).Value
    Range("omr").Value = Sheets("Исходные данные").Cells(i, 56).Value
    Range("od").Value = Sheets("Исходные данные").Cells(i, 57).Value
    Range("odr").Value = Sheets("Исходные данные").Cells(i, 58).Value
    Range("prp").Value = Sheets("Исходные данные").Cells(i, 28).Value
    Range("por").Value = Sheets("Исходные данные").Cells(i, 29).Value
Sheets("Прил2").Select
    Range("plas2").Value = Sheets("Исходные данные").Cells(i, 20).Value
    Range("plas3").Value = Sheets("Исходные данные").Cells(i, 21).Value
Sheets("Прил3").Select
    Range("datazakl2").Value = Sheets("Исходные данные").Cells(i, 1).Value
Sheets("Прил3").Select
    Range("datazakl3").Value = Sheets("Исходные данные").Cells(i, 1).Value
    Range("sop").Value = Sheets("Исходные данные").Cells(i, 37).Value
    Range("eop").Value = Sheets("Исходные данные").Cells(i, 45).Value
    Range("bop").Value = Sheets("Исходные данные").Cells(i, 53).Value
    Range("oop").Value = Sheets("Исходные данные").Cells(i, 61).Value
Sheets("Прил 4, 5").Select
    Range("datazakl4").Value = Sheets("Исходные данные").Cells(i, 1).Value
    Range("datazakl5").Value = Sheets("Исходные данные").Cells(i, 1).Value
    Range("datazakl6").Value = Sheets("Исходные данные").Cells(i, 1).Value
   
 
'Выведем сообщение об окончании
MsgBox ("Выполнено!")
 
End Sub
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
 21.11.2022, 16:48
Ответы с готовыми решениями:

Суррогат Progress Bar
Поскольку Progress Bar использовать не так-то просто в силу разных причин, а кроме того, он не всегда вполне информативен, создал...

Как сделать Progress-bar???
Когда нажимаем на сохранение документа в левом нижнем углу Excel'a появляется прогресс бар. Хотелось бы использовать такой же, когда...

Как в макросе сделать Progres Bar?
Как в макросе сделать Progres Bar (или Meter не знаю как назвать) дабы показать процесс выполнения.

27
0 / 0 / 0
Регистрация: 03.08.2022
Сообщений: 10
23.11.2022, 16:50  [ТС]
Студворк — интернет-сервис помощи студентам
Сильно не ругайте начинающего )
0
0 / 0 / 0
Регистрация: 03.08.2022
Сообщений: 10
23.11.2022, 17:27  [ТС]
Прошу прощения,
3716
0
1412 / 874 / 93
Регистрация: 08.02.2017
Сообщений: 3,726
Записей в блоге: 2
23.11.2022, 18:14
Storfor, могу предложить такой алгоритм (примерно, потому что фиг его знает как у вас там..)
В основном модуле добавляете строчку
Visual Basic
1

Public cnt As Long, MacroRun As Boolean
В самом макросе:
Visual Basic
1
2
3
4

MacroRun = True  'в самом начале
'*** код макроса
MsgBox "Колличество действий :" & cnt 'в самом конце
MacroRun =False
В модуле книги добавляете событийный макрос
Visual Basic
1
2
3

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
      cnt = cnt + 1
End Sub
Так вы узнаете общее количество действий (итераций так сказать). Назовем его countIter
Дальше дописываете в событийный макрос обновление статус бара. Что-то типа так
Visual Basic
1
2
3
4
5
6
7

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
       Const countIter& = 150      
       if MacroRun Then 
            cnt = cnt + 1
            StatusBarUpdate countIter, cnt            
       End If
End Sub
В макросе в конце нужно будет обнулять счетчик
Visual Basic
1

cnt = 0
1
Супер-модератор
Эксперт функциональных языков программированияЭксперт Python
 Аватар для Catstail
38226 / 21158 / 4314
Регистрация: 12.02.2012
Сообщений: 34,773
Записей в блоге: 14
23.11.2022, 19:18
testuser2, "количество" - с одним "л" !
1
0 / 0 / 0
Регистрация: 03.08.2022
Сообщений: 10
25.11.2022, 11:58  [ТС]
testuser2,
Спасибо. Применив предложенное Вами, все получилось.
Единственное, пришлось удалить в коде: "StatusBarUpdate countIter, cnt" словоокончание "Update", а также в коде:

Visual Basic
1
2
3
4
5
6
7
8

Sub StatusBar(ByVal sCur#, ByVal sTotal#, Optional ByVal Msg$ = "Progress")
Dim procCur#, ASU As Boolean
Static sPrev#
    procCur = Round(sTotal / sCur, 1): If sPrev = procCur Then Exit Sub
    ASU = Application.ScreenUpdating: Application.ScreenUpdating = True
    sPrev = procCur: Application.StatusBar = Msg & ": " & Format$(procCur, "0%"): DoEvents
    Application.ScreenUpdating = ASU
End Sub
поменять местами sTotal / sCur так, как вот здесь и записано.

Благодарю еще раз всех участвующих в теме.
Но, если со СтатусБаром все стало ясно, можно развить еще, как реализовать ПрогрессБар )
0
933 / 366 / 43
Регистрация: 10.05.2021
Сообщений: 1,564
Записей в блоге: 10
25.11.2022, 12:05
Storfor, вообще-то, это моя процедура…
0
0 / 0 / 0
Регистрация: 03.08.2022
Сообщений: 10
25.11.2022, 12:44  [ТС]
Jack Famous,
Да, процедура отображения Статус Бара ваша. Поэтому и Вам от меня искренняя благодарность.
Но она не работала бы правильно, не посчитав количество интераций.
Поэтому вы все без исключений молодцы!
0
933 / 366 / 43
Регистрация: 10.05.2021
Сообщений: 1,564
Записей в блоге: 10
25.11.2022, 13:24
Цитата Сообщение от Storfor Посмотреть сообщение
она не работала бы правильно, не посчитав количество интераций
она абсолютна самостоятельна в работе (нужно только 2 числа: текущий номер и всего номеров) — я показал на примере
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
 25.11.2022, 13:24

Progress Bar к выполнению SQL запроса.
Всем Hi! Такой вопрос - по sql запросу из БД выбираются данные. Можно ли к этому привернуть КОРРЕКТНО отображаемый прогрессбар

Использование Microsoft Progress Bar control.
Перед запуском вычислений (допустим длительного цикла) я хочу вывести на экран сообщении, типа подождите. После того как цикл закончится...

Как изменить цвет Progress Bar - Исходник
Проблема в том, что напрямую через свойства контрола нельзя менять цвет баров и цвет фона у Progressbar. Однако, через API эту проблему...

Scroll bar для Form
Вообщем SoftIce поделился своей программкой, но она разрослась до больших значений, я решил выкрутится двумя+ столбцами, ну это не...

Задача по Scroll Bar в List Box
Помогите пожалуйста такая задачка: Я добавляю текст в лист бокс и каждая новая строчка ниже предыдуших а бегунок на скрол баре...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
28
Ответ Создать тему
2 из 2 « 1 2
Новые блоги и статьи
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ"
Adler 06.10.2026
Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .
ИИ не может найти нужный язык в списке
Supersumestria 05.10.2026
Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .
Новая последняя моя музыка в SUNO
zorxor 05.10.2026
Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .
Программный домашний кинотеатр
russiannick 27.09.2026
Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого
zorxor 21.09.2026
Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .
Мобильное приложение ColorStep
pavlinmavlin 17.09.2026
Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части
Maks 13.09.2026
Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр.
Jin X 06.09.2026
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru