返回列表下一主題上一主題發帖

[發問] 自製進度條(不用ProgressBar)

ciboybj

中學生 Rank: 2

帖子: 47
主題: 19
精華: 0
積分: 82
點名: 0
作業系統: win
軟體版本: xp
閱讀權限: 20
註冊時間: 2014-7-4
最後登錄: 2021-9-4

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-2-28 18:46 | 只看該作者

[發問] 自製進度條(不用ProgressBar)

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

程式碼為：

Private Sub UserForm_Activate()
Dim A As Integer
Dim Q As LongLong
Dim TIME As String
TIME = Timer
Q = 100000000
For A = 0 To 300 Step 30
Label2.Width = A
wait (0.5)
DoEvents
Do While Q > 0
Q = Q - 1
Loop
If Q < 0 Then Unload UserForm1
Next
MsgBox "DONE" & Timer - TIME & "Q=" & Q
End Sub
Function wait(S As Single)
Dim PauseTime, Start
PauseTime = S
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Function

複製代碼

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

樓主熱帖

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-27

2^#

發表於 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

TOP

ciboybj

中學生 Rank: 2

帖子: 47
主題: 19
精華: 0
積分: 82
點名: 0
作業系統: win
軟體版本: xp
閱讀權限: 20
註冊時間: 2014-7-4
最後登錄: 2021-9-4

3^#

發表於 2018-2-28 21:24 | 只看該作者

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

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

TOP

靜思自在 : 天上最美是星星，人生最美是溫情。

返回列表下一主題上一主題