VBA Excel의 진행률 표시 줄
데이터베이스에서 많은 데이터를 업데이트해야하는 Excel 앱을 수행하고 있으므로 시간이 걸립니다. 사용자 양식에 진행률 표시 줄을 만들고 싶은데 데이터가 업데이트 될 때 팝업됩니다. 내가 원하는 막대는 약간의 파란색 막대가 오른쪽과 왼쪽으로 이동하고 업데이트가 완료 될 때까지 반복되며 백분율이 필요하지 않습니다. progressbar
컨트롤을 사용해야한다는 것을 알고 있지만 언젠가 시도했지만 만들 수 없습니다.
편집 : 내 문제는 progressbar
컨트롤에 있습니다. 바 '진행'을 볼 수 없습니다. 양식이 팝업되면 완료됩니다. 루프를 사용하는데 DoEvent
작동하지 않습니다. 또한 프로세스가 한 번이 아니라 반복적으로 실행되기를 원합니다.
과거에는 VBA 프로젝트에서 배경색이있는 레이블 컨트롤을 사용하고 진행 상황에 따라 크기를 조정했습니다. 유사한 접근 방식의 몇 가지 예는 다음 링크에서 찾을 수 있습니다.
- http://oreilly.com/pub/h/2607
- http://www.ehow.com/how_7764247_create-progress-bar-vba.html
- http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/
다음은 Excel의 Autoshapes를 사용하는 것입니다.
http://www.andypope.info/vba/pmeter.htm
때때로 상태 표시 줄의 간단한 메시지로 충분합니다.
이것은 구현하기 매우 간단합니다 .
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를 진행률 표시 줄로 사용하는 또 다른 예입니다.
일부 유니 코드 문자를 사용하여 진행률 표시 줄을 모방 할 수 있습니다. 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 =============
워크 시트에 단추를 만듭니다. 버튼을 "ShowProgress"매크로에 매핑
2 개의 버튼, 진행률 표시 줄, 막대 상자, 텍스트 상자가있는 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 .....)
이게 도움이 되길 바란다.
여기에 게시 된 모든 솔루션이 마음에 들지만 조건부 서식을 백분율 기반 데이터 막대로 사용하여이 문제를 해결했습니다.
이것은 아래와 같이 셀 행에 적용됩니다. 0 % 및 100 %를 포함하는 셀은 "ScanProgress"라는 이름의 범위 (왼쪽) 컨텍스트를 제공하기 위해 있기 때문에 일반적으로 숨겨집니다.
코드에서 나는 몇 가지 일을하는 테이블을 반복하고 있습니다.
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
안녕하세요 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
progressbar
사용자 폼 의 컨트롤에 대해 repaint
이벤트를 사용하지 않으면 진행률이 표시되지 않습니다 . 이 이벤트를 루핑 내부에 코딩해야합니다 (그리고 분명히 progressbar
값을 증가시켜야합니다 ).
사용 예 :
userFormName.repaint
다른 많은 훌륭한 게시물이 있지만 이론적으로는 REAL 진행률 표시 줄 컨트롤 을 만들 수 있어야한다고 말하고 싶습니다 .
CreateWindowEx()
진행률 표시 줄을 만드는 데 사용
C ++ 예 :
hwndPB = CreateWindowEx(0, PROGRESS_CLASS, (LPTSTR) NULL, WS_CHILD | WS_VISIBLE, rcClient.left,rcClient.bottom - cyVScroll,rcClient.right, cyVScroll,hwndParent, (HMENU) 0, g_hinst, NULL);
hwndParent
부모 창으로 설정해야합니다. 이를 위해 상태 표시 줄 또는 사용자 지정 양식을 사용할 수 있습니다! 다음은 Spy ++에서 찾은 Excel의 창 구조입니다.
따라서 이것은 FindWindowEx()
함수를 사용하여 비교적 간단해야 합니다.
hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar")
After the progress bar has been created you must use SendMessage()
to interact with the progress bar:
Function MAKELPARAM(ByVal loWord As Integer, ByVal hiWord As Integer)
Dim lparam As Long
MAKELPARAM = loWord Or (&H10000 * hiWord)
End Function
SendMessage(hwndPB, PBM_SETRANGE, 0, MAKELPARAM(0, 100))
SendMessage(hwndPB, PBM_SETSTEP, 1, 0)
For i = 1 to 100
SendMessage(hwndPB, PBM_STEPIT, 0, 0)
Next
DestroyWindow(hwndPB)
I'm not sure how practical this solution is, but it might look somewhat more 'official' than other methods stated here.
Just adding my part to the above collection.
If you are after less code and maybe cool UI. Check out my GitHub for Progressbar for VBA
a customisable one:
The Dll is thought for MS-Access but should work in all VBA platform with minor changes. There is also an Excel file with samples. You are free to expand the vba wrappers to suit your needs.
This project is currently under development and not all errors are covered. So expect some!
You should be worried about 3rd party dlls and if you are, please feel free to use any trusted online antivirus before implementing the dll.
I liked the Status Bar from this page:
https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/
I updated it so it could be used as a called procedure. No credit to me.
showStatus Current, Total, " Process Running: "
Private Sub showStatus(Current As Integer, lastrow As Integer, Topic As String)
Dim NumberOfBars As Integer
Dim pctDone As Integer
NumberOfBars = 50
'Application.StatusBar = "[" & Space(NumberOfBars) & "]"
' Display and update Status Bar
CurrentStatus = Int((Current / lastrow) * NumberOfBars)
pctDone = Round(CurrentStatus / NumberOfBars * 100, 0)
Application.StatusBar = Topic & " [" & String(CurrentStatus, "|") & _
Space(NumberOfBars - CurrentStatus) & "]" & _
" " & pctDone & "% Complete"
' Clear the Status Bar when you're done
' If Current = Total Then Application.StatusBar = ""
End Sub
Nice dialog progressbar form i looked for. progressbar from alainbryden
very simple to use, and looks nice.
edit: link works only for premium members now :/
here is nice alternative class.
Solution posted by @eykanal may not be the best in case you have huge amount of data to deal with as the enabling the status bar would slow down the code execution.
Following link explains a nice way to build a progress bar. Works well with high data volume (~250K records +):
http://www.excel-easy.com/vba/examples/progress-indicator.html
참고 URL : https://stackoverflow.com/questions/5181164/progress-bar-in-vba-excel
'Programing' 카테고리의 다른 글
iOS 7 또는 6에서 탐색 모음 색상을 변경하는 방법은 무엇입니까? (0) | 2020.11.19 |
---|---|
네이티브 테이블 'performance_schema'. '???' (0) | 2020.11.19 |
Rails 3.1.0 마이그레이션에서 remove_index의 올바른 구문은 무엇입니까? (0) | 2020.11.19 |
Java에서 곱하고 나누는 것보다 비트 이동이 더 빠릅니까? (0) | 2020.11.19 |
/ public의 정적 HTML 페이지로 라우팅 (0) | 2020.11.18 |