標題: [發問] 自製進度條(不用ProgressBar) [打印本頁]

---

作者: ciboybj    時間: 2018-2-28 18:46     標題: 自製進度條(不用ProgressBar)

大家好
由於VBA 原生ProgressBar 必須在使用者有安裝相關套件的情況下才能呈現，所以我想要不用原生ProgressBar的方式，自製進度條
呈現方式大概如下：
先自製一個表單，並在表單中加入框架（FRAME），然後在框架中加入標籤（LABEL），之後表單顯示時，改變標籤的寬度，以呈現出跑進度的效果
[attach]28403[/attach]
程式碼為：

1. Private Sub UserForm_Activate()
   
2.     Dim A As Integer
   
3.     Dim Q As LongLong
   
4.     Dim TIME As String
   
5.     TIME = Timer
   
6.             Q = 100000000
   
7.     For A = 0 To 300 Step 30
   
8.         Label2.Width = A
   
9.          wait (0.5)
   
10.          DoEvents
    
11.             Do While Q > 0
    
12.                 Q = Q - 1
    
13.             Loop
    
14.             If Q < 0 Then Unload UserForm1
    
15.     Next
    
16.     MsgBox "DONE" & Timer - TIME & "Q=" & Q
    
17. End Sub
    
18. Function wait(S As Single)
    
19. Dim PauseTime, Start
    
20. PauseTime = S
    
21. Start = Timer
    
22. Do While Timer < Start + PauseTime
    
23.     DoEvents
    
24. Loop
    
25. End Function

複製代碼

我預期的效果是，電腦在處理Q遞減1的程序中，同步改變LABLE的寬度
但上面的程式跑出來的結果似乎是，在跑完Q遞減1的程序後，才跑改變LABEL的寬度程式
想請問大家，上面程式要怎麼改才會是，同時跑Q遞減1程序及改變LABEL的寬度的程序
謝謝∼

---

作者: jackyq    時間: 2018-2-28 19:34

Private Sub UserForm_Activate()
        Dim A As Integer
        Dim Q As Long
        Dim TIME As String
        TIME = Timer
            ' Q = 100000000  error
        For A = 0 To 300 Step 30
            Label2.Width = A
            Q = 100000000  'right
             'wait (0.5)
             DoEvents
                Do While Q > 0
                    If Q Mod 1000000 = 0 Then
                       DoEvents
                    End If
                    Q = Q - 1
                Loop
                If Q < 0 Then Unload UserForm1
        Next
        MsgBox "DONE" & Timer - TIME & "Q=" & Q
    End Sub

---

作者: ciboybj    時間: 2018-2-28 21:24

本帖最後由 ciboybj 於 2018-2-28 21:29 編輯

TO jackyq
感謝你的回覆
我再研究一下

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)