반응형
Excel VBA에서 진행 표시줄을 만들려면 어떻게 해야 합니까?
데이터베이스에서 데이터를 많이 업데이트해야 하는 Excel 앱을 하고 있기 때문에 시간이 걸립니다.사용자 양식에 진행 표시줄을 만들고 싶은데 데이터가 업데이트될 때 팝업됩니다.내가 원하는 바는 단지 작은 파란색 막대가 좌우로 움직이며 업데이트가 완료될 때까지 반복하는 것입니다. 퍼센티지는 필요하지 않습니다.
도 이 말을 것을 있습니다.progressbar통제하려고 했지만, 한동안 시도했지만, 해낼 수 없었어요.
는 ★★★★에 있다.progressbar컨트롤, '진행 중'이라는 막대가 보이지 않습니다.폼이 뜨면 완료됩니다.를 사용하고 있습니다.DoEvent만 실행하는 것이 해 주었으면 합니다.또한 한 번이 아니라 반복적으로 프로세스를 실행했으면 합니다.
상태 표시줄에 표시되는 간단한 메시지로 충분할 수 있습니다.
이것은 매우 간단하게 구현할 수 있습니다.
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
다음은 상태 표시줄을 진행 표시줄로 사용하는 다른 예입니다.
일부 유니코드 문자를 사용하여 진행률 표시줄을 흉내낼 수 있습니다.9608 - 9615는 제가 바에서 시도했던 코드입니다.막대 사이에 표시할 간격에 따라 하나를 선택합니다.바의 길이는 NUM_BARS를 변경하여 설정할 수 있습니다.또한 클래스를 사용하여 상태 표시줄 초기화 및 해제를 자동으로 처리하도록 설정할 수 있습니다.오브젝트가 범위를 벗어나면 자동으로 상태 표시줄이 정리되고 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
지금까지 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
여기에 게재되어 있는 모든 솔루션이 마음에 듭니다만, 이 문제를 해결하기 위해서는 퍼센티지 베이스의 데이터 바를 사용하여 조건 포맷을 실시합니다.
이것은 다음과 같이 셀의 행에 적용됩니다.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
최소한의 코드, 괜찮은 것 같아.
============== This code goes in Module1 ============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
워크시트에 버튼을 만들고 버튼을 "Show Progress" 매크로에 매핑합니다.
2개의 명령 버튼과 3개의 라벨이 있는 User Form1을 작성하여 다음 객체를 가져옵니다.
| 요소 | 목적 | 설정할 속성 |
|---|---|---|
UserForm1 |
캔버스(다른 5가지 요소를 포함) | |
CommandButton1 |
사용자 양식 1을 닫습니다. | 제목 : "닫기" |
CommandButton2 |
진행률 바코드 실행 | 제목 : "실행" |
Bar1(라벨) |
진행률 표시줄 그래픽 | 백컬러: 블루 |
BarBox(라벨) |
진행률 표시줄을 프레임할 빈 상자 | 백컬러:하얀색 |
Counter(라벨) |
진행률 표시줄을 구동하는 데 사용되는 정수 표시 |
그런 다음 User Form1에 다음 코드를 추가합니다.
======== 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 ' Memorize initial/maximum 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 =====================
이 페이지의 상태 표시줄이 마음에 들었습니다.
https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/
호출 절차로 사용할 수 있도록 업데이트했습니다.난 신용이 없다.
Call 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
코드가 진행됨에 따라 라벨 컨트롤의 폭을 늘리는 코드를 사용하여 VBA에 양식을 만들 수 있습니다.레이블 컨트롤의 너비 특성을 사용하여 크기를 조정할 수 있습니다.라벨의 배경색 속성을 원하는 색으로 설정할 수 있습니다.그러면 자체 진행 표시줄을 만들 수 있습니다.
크기를 조정하는 라벨 제어는 빠른 솔루션입니다.그러나 대부분의 사람들은 결국 각각의 매크로에 대한 개별 양식을 만듭니다.DoEvents 함수와 modeless 폼을 사용하여 모든 매크로에 대해 단일 폼을 사용합니다.
다음은 제가 쓴 블로그 글입니다.http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
폼과 모듈을 프로젝트에 Import하고 Call mod Progress를 사용하여 프로그레스 바를 호출하기만 하면 됩니다.Show Progress(액션)인덱스, Total Actions, Title.....)
이게 도움이 됐으면 좋겠어요.
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
위 컬렉션에 제 파트를 추가하는 중입니다.
코드나 UI를 줄이고 싶다면.GitHub에서 VBA용 프로그레스바를 확인하세요.
커스터마이즈 가능한 것:
Dll은 MS-Access용으로 생각되지만 사소한 변경을 가하면 모든 VBA 플랫폼에서 동작합니다.샘플이 포함된 엑셀 파일도 있습니다.필요에 따라 vba 래퍼를 자유롭게 확장할 수 있습니다.
이 프로젝트는 현재 개발 중이며 모든 오류가 적용되는 것은 아닙니다.기대해주세요!
서드파티제의 dll에 대해 걱정하셔야 합니다.그렇다면 dll을 구현하기 전에 신뢰할 수 있는 온라인 안티바이러스를 사용해 주십시오.
그 밖에도 훌륭한 투고가 많이 있습니다만, 이론적으로는 리얼 프로그레스 바 컨트롤을 작성할 수 있어야 합니다.
- 사용하다
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")
진행률 표시줄이 생성된 후 다음을 사용해야 합니다.SendMessage()진행 표시줄과 상호 작용하려면:
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)
이 솔루션이 얼마나 실용적인지는 모르겠지만, 여기에 명시된 다른 방법보다 다소 '공식적'으로 보일 수 있습니다.
폼을 추가하여 Form1로 이름을 붙일 수 있습니다.또한 프레임을 Frame1 및 Label1로 추가할 수도 있습니다.프레임 1의 폭을 200으로, 백컬러를 블루로 설정합니다.모듈에 코드를 삽입하여 도움이 되는지 확인합니다.
Sub Main()
Dim i As Integer
Dim response
Form1.Show vbModeless
Form1.Frame1.Width = 0
For i = 10 To 10000
With Form1
.Label1.Caption = Round(i / 100, 0) & "%"
.Frame1.Width = Round(i / 100, 0) * 2
DoEvents
End With
Next i
Application.Wait Now + 0.0000075
Unload Form1
response = MsgBox("100% Done", vbOKOnly)
End Sub
상태 표시줄에 표시하려면 보다 간단한 다른 방법을 사용할 수 있습니다.
Sub Main()
Dim i As Integer
Dim response
For i = 10 To 10000
Application.StatusBar = Round(i / 100, 0) & "%"
Next i
Application.Wait Now + 0.0000075
response = MsgBox("100% Done", vbOKOnly)
End Sub
나는 이것이 오래된 실이라는 것을 알지만, 나는 이것에 대해 알지 못하고 비슷한 질문을 했었다.Excel VBA Progress Bar가 필요했는데 이 링크를 찾았습니다.Excel VBA Status Bar여기 제가 쓴 일반화된 버전이 있습니다.두 가지 메서드가 있습니다.기본값은 "[|| ] 20% Complete"로 되어 있는 단순 버전 DisplaySimpleProgressBarStep과 옵션 인수의 세탁 목록을 사용하여 원하는 대로 표시할 수 있는 보다 일반적인 버전 DisplayProgressBarStep입니다.
Option Explicit
' Resources
' ASCII Chart: https://vbaf1.com/ascii-table-chart/
Private Enum LabelPlacement
None = 0
Prepend
Append
End Enum
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If
Public Sub Test()
Call ProgressStatusBar(Last:=10)
End Sub
Public Sub Test2()
Const lMilliseconds As Long = 500
Dim lIndex As Long, lNumberOfBars As Long
Dim sBarChar As String
sBarChar = Chr$(133) ' Elipses …
sBarChar = Chr$(183) ' Middle dot ·
sBarChar = Chr$(176) ' Degree sign °
sBarChar = Chr$(171) ' Left double angle «
sBarChar = Chr$(187) ' Right double angle »
sBarChar = Chr$(166) ' Broken vertical bar ¦
sBarChar = Chr$(164) ' Currency sign ¤
sBarChar = Chr$(139) ' Single left-pointing angle quotation mark ‹
sBarChar = Chr$(155) ' Single right-pointing angle quotation mark ›
sBarChar = Chr$(149) ' Bullet •
sBarChar = "|"
For lIndex = 1 To 10
Call DisplayProgressBarStep(lIndex, 10, 50, LabelPlacement.Append, sBarChar)
Call Sleep(lMilliseconds)
Next
Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2 Completed")
Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
End Sub
Public Sub Test2Simple()
Const lMilliseconds As Long = 500
Dim lIndex As Long, lNumberOfBars As Long
For lIndex = 1 To 10
Call DisplayProgressBarStep(lIndex, 10, 50)
Call Sleep(lMilliseconds)
Next
Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2Simple Completed")
Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
End Sub
''' <summary>
''' Method to display an Excel ProgressBar. Called once for each step in the calling code process.
''' Defaults to vertical bar surrounded by square brackets with a trailing percentage label (e.g. [|||||] 20% Complete).
'''
''' Adapted
''' From: Excel VBA StatusBar
''' Link: https://www.wallstreetmojo.com/vba-status-bar/
''' </summary>
''' <param name="Step">The current step count.</param>
''' <param name="StepCount">The total number of steps.</param>
''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
''' <param name="LabelPlacement">Optional, Can be None, Prepend or Append. Defaults to Append.</param>
''' <param name="BarChar">Optional, Character that makes up the horizontal bar. Defaults to | (Pipe).</param>
''' <param name="PrependedBoundaryText">Optional, Boundary text prepended to the StatusBar. Defaults to [ (Left square bracket).</param>
''' <param name="AppendedBoundaryText">Optional, Boundary text appended to the StatusBar. Defaults to ] (Right square bracket).</param>
''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
Private Sub DisplayProgressBarStep( _
lStep As Long, _
lStepCount As Long, _
Optional lNumberOfBars As Long = 0, _
Optional eLabelPlacement As LabelPlacement = LabelPlacement.Append, _
Optional sBarChar As String = "|", _
Optional sPrependedBoundaryText As String = "[", _
Optional sAppendedBoundaryText As String = "]", _
Optional bClearStatusBar As Boolean = False _
)
Dim lCurrentStatus As Long, lPctComplete As Long
Dim sBarText As String, sLabel As String, sStatusBarText As String
If bClearStatusBar Then
Application.StatusBar = False
Exit Sub
End If
If lNumberOfBars = 0 Then
lNumberOfBars = lStepCount
End If
lCurrentStatus = CLng((lStep / lStepCount) * lNumberOfBars)
lPctComplete = Round(lCurrentStatus / lNumberOfBars * 100, 0)
sLabel = lPctComplete & "% Complete"
sBarText = sPrependedBoundaryText & String(lCurrentStatus, sBarChar) & Space$(lNumberOfBars - lCurrentStatus) & sAppendedBoundaryText
Select Case eLabelPlacement
Case LabelPlacement.None: sStatusBarText = sBarText
Case LabelPlacement.Prepend: sStatusBarText = sLabel & " " & sBarText
Case LabelPlacement.Append: sStatusBarText = sBarText & " " & sLabel
End Select
Application.StatusBar = sStatusBarText
''Debug.Print "CurStatus:"; lCurrentStatus, "PctComplete:"; lPctComplete, "'"; sStatusBarText; "'"
End Sub
''' <summary>
''' Method to display a simple Excel ProgressBar made up of vertical bars | with a trailing label. Called once for each step in the calling code process.
'''
''' Adapted
''' From: Excel VBA StatusBar
''' Link: https://www.wallstreetmojo.com/vba-status-bar/
''' </summary>
''' <param name="Step">The current step count.</param>
''' <param name="StepCount">The total number of steps.</param>
''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
Private Sub DisplaySimpleProgressBarStep( _
lStep As Long, _
lStepCount As Long, _
Optional lNumberOfBars As Long = 0, _
Optional bClearStatusBar As Boolean = False _
)
Call DisplayProgressBarStep(lStep, lStepCount, lNumberOfBars, bClearStatusBar:=bClearStatusBar)
End Sub
언급URL : https://stackoverflow.com/questions/5181164/how-can-i-create-a-progress-bar-in-excel-vba
반응형
'programing' 카테고리의 다른 글
| python에서 작성 날짜별로 정렬된 디렉토리 목록을 가져오려면 어떻게 해야 합니까? (0) | 2023.04.18 |
|---|---|
| T-SQL을 사용한 퍼지 매칭 (0) | 2023.04.18 |
| NSString을 NSNumber로 변환하는 방법 (0) | 2023.04.13 |
| ERROR ITMS-9000: "용장 바이너리 업로드.열차 '1.0'의 빌드 버전이 '1.0'인 바이너리 업로드가 이미 존재합니다." (0) | 2023.04.13 |
| XAML에서 명령 매개 변수로 열거 값 전달 (0) | 2023.04.13 |