进度指示器,在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