进度指示器,在vba中没有响应
我一直在通过stackoverflow阅读如何使用进度栏。
它工作正常,但在短时间6%后,在我235的数组中的第14行说,没有响应,直到循环结束。
所以我正在运行它vbmodeless:
ProgressBar.Show vbModeless ProgressBar.Label_WhatsGoingOn.Caption = "Reading data from database.." projectNumber = "32966" docOutArray = Post.helpRequest("xdnjgjrdin.asp?Dok4=" & projectNumber) If CPearson.IsArrayEmpty(docOutArray) Then MsgBox "No document registered in database!" End If ProgressBar.Label_WhatsGoingOn.Caption = "Creating Docout.." Set doc_ = NEwDocOut.createDocOutDocument(projectNumber) numOfRows = UBound(docOutArray, 1) For i = LBound(docOutArray, 1) To numOfRows ProgressBar.Label_WhatsGoingOn.Caption = "Creating Row.." sPercentage = (i / numOfRows) * 100 ProgressBar.progress (sPercentage)
我的进度条代码:
Private Sub UserForm_Initialize() Me.Text.Caption = "0% Completed" End Sub Public Sub progress(pctCompl As Single) Me.Text.Caption = Format(pctCompl, "##") & "% Completed" Me.Bar.Width = pctCompl * 2 Me.Repaint DoEvents End Sub
任何想法为什么发生这种情况
这已经让我讨厌了一段时间了,你促使我寻找答案 – 谢谢。
实际上非常简单,只要在你的循环中放入DoEvents
就可以了:
For i = LBound(docOutArray, 1) To numOfRows 'Add this line here: DoEvents ProgressBar.Label_WhatsGoingOn.Caption = "Creating Row.." sPercentage = (i / numOfRows) * 100 ProgressBar.progress (sPercentage)
这是我更新的代码build议:
Public Sub progress(pctCompl As Single) Me.Text.Caption = Format(pctCompl, "##") & "% Completed" Me.Bar.Width = pctCompl * 2 Me.Repaint End Sub Public Sub setMessage(message As String, Optional percentage As Single = 0#) If Not ProgressBar.Visible Then ProgressBar.Show vbModeless ProgressBar.Label_WhatsGoingOn.Caption = message If percentage <> 0 Then Call ProgressBar.progress(percentage) End Sub