Đây là một ví dụ khác bằng cách sử dụng thanh trạng thái như một thanh tiến trình.
Bằng cách sử dụng một số ký tự Unicode, bạn có thể bắt chước thanh tiến trình. 9608 - 9615 là những mã tôi đã thử cho các thanh. Chỉ cần chọn một theo bao nhiêu không gian bạn muốn hiển thị giữa các thanh. Bạn có thể đặt độ dài của thanh bằng cách thay đổi NUM_BARS. Cũng bằng cách sử dụng một lớp, bạn có thể thiết lập nó để xử lý khởi tạo và phát hành Statusbar một cách tự động. Một khi đối tượng đi ra khỏi phạm vi nó sẽ tự động dọn dẹp và phát hành StatusBar trở lại 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
Sample Cách sử dụng:
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
Nguồn
2013-09-07 01:38:07
"cố gắng trong một thời gian, nhưng không thể làm cho nó" - cho chúng ta thấy những gì bạn đã quản lý để làm, các vấn đề là gì và chúng tôi sẽ cố gắng giúp bạn –
thx để được tư vấn, xem chỉnh sửa – darkjh