Я делаю приложение Excel, которому требуется много обновлений данных из базы данных, поэтому требуется время. Я хочу создать индикатор выполнения в пользовательской форме, и он появляется, когда данные обновляются. Панель, которую я хочу, - это всего лишь небольшая синяя полоса, перемещающаяся вправо и влево и повторяющаяся до тех пор, пока обновление не будет выполнено, никакого необходимого процента.
Я знаю, что я должен использовать элемент управления progressbar
, но иногда я пытался, но не могу его сделать.
EDIT: Моя проблема связана с элементом управления progressbar
, я не могу видеть прогресс в баре, он просто заканчивается при появлении формы. Я использую цикл и DoEvent
, но это не работает. Кроме того, я хочу, чтобы процесс повторялся, а не только один раз.
В прошлом, с проектами VBA, я использовал элемент управления ярлыком с цветным фоном и настраивал размер на основе прогресса. Некоторые примеры с подобными подходами можно найти в следующих ссылках:
Вот пример, который использует Excel Autoshapes:
Иногда достаточно простого сообщения в строке состояния:
Dim x As Integer
Dim MyTimer As Double
'Change this loop as needed.
For x = 1 To 50
' Do stuff
Application.StatusBar = "Progress: " & x & " of 50: " & Format(x / 50, "0%")
Next x
Application.StatusBar = False
Вот еще один пример использования StatusBar в качестве индикатора выполнения.
Используя некоторые символы Unicode, вы можете имитировать индикатор выполнения. 9608 - 9615 - это коды, которые я пробовал для баров. Просто выберите один из них в зависимости от того, сколько места вы хотите показывать между барами. Вы можете установить длину полосы, изменив NUM_BARS. Кроме того, используя класс, вы можете настроить его для автоматической инициализации и освобождения StatusBar. Как только объект выходит из области действия, он автоматически очистит и отпустит StatusBar обратно в Excel.
' Class Module - ProgressBar
Option Explicit
Private statusBarState As Boolean
Private enableEventsState As Boolean
Private screenUpdatingState As Boolean
Private Const NUM_BARS As Integer = 50
Private Const MAX_LENGTH As Integer = 255
Private BAR_CHAR As String
Private SPACE_CHAR As String
Private Sub Class_Initialize()
' Save the state of the variables to change
statusBarState = Application.DisplayStatusBar
enableEventsState = Application.EnableEvents
screenUpdatingState = Application.ScreenUpdating
' set the progress bar chars (should be equal size)
BAR_CHAR = ChrW(9608)
SPACE_CHAR = ChrW(9620)
' Set the desired state
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
Private Sub Class_Terminate()
' Restore settings
Application.DisplayStatusBar = statusBarState
Application.ScreenUpdating = screenUpdatingState
Application.EnableEvents = enableEventsState
Application.StatusBar = False
End Sub
Public Sub Update(ByVal Value As Long, _
Optional ByVal MaxValue As Long= 0, _
Optional ByVal Status As String = "", _
Optional ByVal DisplayPercent As Boolean = True)
' Value : 0 to 100 (if no max is set)
' Value : >=0 (if max is set)
' MaxValue : >= 0
' Status : optional message to display for user
' DisplayPercent : Display the percent complete after the status bar
' <Status> <Progress Bar> <Percent Complete>
' Validate entries
If Value < 0 Or MaxValue < 0 Or (Value > 100 And MaxValue = 0) Then Exit Sub
' If the maximum is set then adjust value to be in the range 0 to 100
If MaxValue > 0 Then Value = WorksheetFunction.RoundUp((Value * 100) / MaxValue, 0)
' Message to set the status bar to
Dim display As String
display = Status & " "
' Set bars
display = display & String(Int(Value / (100 / NUM_BARS)), BAR_CHAR)
' set spaces
display = display & String(NUM_BARS - Int(Value / (100 / NUM_BARS)), SPACE_CHAR)
' Closing character to show end of the bar
display = display & BAR_CHAR
If DisplayPercent = True Then display = display & " (" & Value & "%) "
' chop off to the maximum length if necessary
If Len(display) > MAX_LENGTH Then display = Right(display, MAX_LENGTH)
Application.StatusBar = display
End Sub
Пример использования:
Dim progressBar As New ProgressBar
For i = 1 To 100
Call progressBar.Update(i, 100, "My Message Here", True)
Application.Wait (Now + TimeValue("0:00:01"))
Next
============== This code goes in Module1 ============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
Создать кнопку на листе; map на макрос "ShowProgress"
Создайте UserForm1 с двумя кнопками, индикатором выполнения, панелью, текстовым полем:
UserForm1 = canvas to hold other 5 elements
CommandButton2 = Run Progress Bar Code; Caption:Run
CommandButton1 = Close UserForm1; Caption:Close
Bar1 (label) = Progress bar graphic; BackColor:Blue
BarBox (label) = Empty box to frame Progress Bar; BackColor:White
Counter (label) = Display the integers used to drive the progress bar
======== Attach the following code to UserForm1 =========
Option Explicit
' This is used to create a delay to prevent memory overflow
' remove after software testing is complete
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub UserForm_Initialize()
Bar1.Tag = Bar1.Width
Bar1.Width = 0
End Sub
Sub ProgressBarDemo()
Dim intIndex As Integer
Dim sngPercent As Single
Dim intMax As Integer
'==============================================
'====== Bar Length Calculation Start ==========
'-----------------------------------------------'
' This section is where you can use your own '
' variables to increase bar length. '
' Set intMax to your total number of passes '
' to match bar length to code progress. '
' This sample code automatically runs 1 to 100 '
'-----------------------------------------------'
intMax = 100
For intIndex = 1 To intMax
sngPercent = intIndex / intMax
Bar1.Width = Int(Bar1.Tag * sngPercent)
Counter.Caption = intIndex
'======= Bar Length Calculation End ===========
'==============================================
DoEvents
'------------------------
' Your production code would go here and cycle
' back to pass through the bar length calculation
' increasing the bar length on each pass.
'------------------------
'this is a delay to keep the loop from overrunning memory
'remove after testing is complete
Sleep 10
Next
End Sub
Private Sub CommandButton1_Click() 'CLOSE button
Unload Me
End Sub
Private Sub CommandButton2_Click() 'RUN button
ProgressBarDemo
End Sub
================= UserForm1 Code Block End =====================
============== This code goes in Module1 =============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
Элемент управления, который изменяет размер, является быстрым решением. Однако большинство людей создают индивидуальные формы для каждого из своих макросов. Я использовал функцию DoEvents и немодальную форму для использования одной формы для всех ваших макросов.
Вот сообщение в блоге, которое я написал об этом: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
Все, что вам нужно сделать, это импортировать форму и модуль в свои проекты и вызвать индикатор выполнения: Call modProgress.ShowProgress(ActionIndex, TotalActions, Title.....)
Надеюсь, это поможет.
О элементе управления progressbar
в пользовательской форме он не покажет никакого прогресса, если вы не используете событие repaint
. Вы должны закодировать это событие внутри цикла (и, очевидно, увеличивать значение progressbar
).
Пример использования:
userFormName.repaint
Привет, модифицированная версия другого сообщения от Marecki. Имеет 4 стиля
1. dots ....
2 10 to 1 count down
3. progress bar (default)
4. just percentage.
Прежде чем вы спросите, почему я не редактировал этот пост, я это сделал, и ему было отказано, чтобы он ответил на новый ответ.
Sub ShowProgress()
Const x As Long = 150000
Dim i&, PB$
For i = 1 To x
DoEvents
UpdateProgress i, x
Next i
Application.StatusBar = ""
End Sub 'ShowProgress
Sub UpdateProgress(icurr As Long, imax As Long, Optional istyle As Integer = 3)
Dim PB$
PB = Format(icurr / imax, "00 %")
If istyle = 1 Then ' text dots >>.... <<'
Application.StatusBar = "Progress: " & PB & " >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
ElseIf istyle = 2 Then ' 10 to 1 count down (eight balls style)
Application.StatusBar = "Progress: " & PB & " " & ChrW$(10111 - Val(PB) / 11)
ElseIf istyle = 3 Then ' solid progres bar (default)
Application.StatusBar = "Progress: " & PB & " " & String(100 - Val(PB), ChrW$(9608))
Else ' just 00 %
Application.StatusBar = "Progress: " & PB
End If
End Sub
Я люблю все решения, размещенные здесь, но я решил это с помощью условного форматирования в виде базирующейся на процентах панели данных.
Это применяется к ряду ячеек, как показано ниже. Ячейки, которые содержат 0% и 100%, обычно скрыты, потому что они просто там, чтобы дать контекст с именем "LeftProgress" (слева).
В коде я прохожу через таблицу, делающую некоторые вещи.
For intRow = 1 To shData.Range("tblData").Rows.Count
shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count
DoEvents
' Other processing
Next intRow
Минимальный код, выглядит прилично.
Sub ShowProgress()
' Author : Marecki
Const x As Long = 150000
Dim i&, PB$
For i = 1 To x
PB = Format(i / x, "00 %")
Application.StatusBar = "Progress: " & PB & " >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
Application.StatusBar = "Progress: " & PB & " " & ChrW$(10111 - Val(PB) / 11)
Application.StatusBar = "Progress: " & PB & " " & String(100 - Val(PB), ChrW$(9608))
Next i
Application.StatusBar = ""
End SubShowProgress
Решение, отправленное @eykanal, может быть не лучшим, если у вас есть огромное количество данных для обработки, поскольку включение строки состояния приведет к замедлению выполнения кода.
Следующая ссылка объясняет хороший способ создания индикатора выполнения. Хорошо работает с большим объемом данных (~ 250K записей +):
http://www.excel-easy.com/vba/examples/progress-indicator.html
Хорошая диалоговая панель прогресса, которую я искал. progressbar from alainbryden
очень прост в использовании и выглядит хорошо.
ссылка: ссылка работает только для премиум-членов:/
здесь - хороший альтернативный класс.