步数未知的 Word VBA 进度条

问题描述

我有一个循环次数未知的宏。次数根据参考文档中多个表中的总行数而变化，并且行数将因可能使用的参考文档而异。循环的相关代码片段如下：

For Each oRow In oTbl.Rows
    p = p + 1
    Helper.ProgressIndicator_Code (p)
    strPhrase = Split(Trim(oRow.Range.Cells(1).Range.Text),vbCr)(0)
    strRule = Split(Trim(oRow.Cells(2).Range.Text),vbCr)(0)
    If strPhrase <> "" Then
      If Not strStartWord = vbNullString Then
        'Process defined sections
        arrEndWords = Split(strEndWord,"|")
        For lngIndex = 0 To UBound(arrEndWords)
          Set oRng = GetDocRange(strStartWord,arrEndWords(lngIndex))
          If Not oRng Is nothing Then Exit For
        Next lngIndex
      Else
        'Process whole document
        Set oRng = m_odocCurrent.Range
      End If
      If Not oRng Is nothing Then
        Set oRngScope = oRng.Duplicate
        With oRng.Find
          .Text = strPhrase
          do while .Execute
            If Not oRng.InRange(oRngScope) Then Exit For
            oRng.HighlightColorIndex = wdTurquoise
                        If strRule <> "" Then
              Set oComment = m_odocCurrent.Comments.Add(Range:=oRng,Text:=strUsr & ": " & strRule)
              oComment.Author = UCase("WordCheck")
              oComment.Initial = UCase("WC")
            End If
          Loop
        End With
      End If
    End If
  Next oRow

进度条是一个经典的进度条，根据上面代码中更新的 p 值，使用以下代码更新标签字段宽度：

Sub progress(pctCompl As Integer)

  ProgressIndicator.Text.Caption = pctCompl & "% Completed"
  ProgressIndicator.Bar.Width = pctCompl * 2

  DoEvents

End Sub

这是我的问题：p 的值因使用的参考文档而异，因此我的进度条在 VBA 宏的处理方面甚至从未大致准确。进度条不一定要准确，只要关闭并指示正在取得进展并且没有任何挂起。

我不是在寻找书面代码，只是非常感谢有关使我的进度条更准确以便我可以学习的方法的建议或建议（例如，我只是为三个不同的参考文档运行了宏 -一个给了我 25%，一个给了 44%，一个给了 82%；完成时没有一个显示接近 100%）。基本上我需要将 i 除以一个未知数来得到我的百分比，这显然是不可能的，所以需要一些函数来进行近似。

编辑：基于@macropod 建议的新代码。

Dim strCheckDoc As String,docRef As Document,projectPath As String,_
  j As Integer,i As Integer,k As Integer,oNumRows as Long

j = 1

For i = 0 To UBound(strUsr)
  strCheckDoc = [path to reference document unique to each strUsr]
  Set docRef = Documents.Open(strCheckDoc,ReadOnly:=True,Visible:=False)
  
 For k = 1 To docRef.Tables.Count
   oNumRows = oNumRows + docRef.Tables(i).Rows.Count
 Next k
Next i

那么更新进度条的代码是：

Dim pctCompl As Single

pctCompl = Round((p / oNumRows) * 100)
ProgressIndicator.Text.Caption = pctCompl & "% Completed"
ProgressIndicator.Bar.Width = pctCompl * 2

DoEvents

进度条现在在完成时达到 64%（即它应该是 100%）。我还在研究一种方法，使 oNumRows 仅在第一列中有内容时才计算一行。

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）