진행 표시기, vba에서 응답하지 않게 됨

Question

진행률 막대 사용 방법에 대해 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 

이런 일이 발생하는 이유 어떤 아이디어?

Answer 1

이 잠시 동안 나를 성가신하고 당신은 답변 - 감사 찾기 위해 저 자극했습니다.

당신의 경우, 루프 내부 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) 

Answer 2

내 업데이트 된 코드의 제안입니다 :

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