Word中VBA代码移除MsgBox后陷入无限循环问题求助

问题概述 #

需求为遍历Word文档，当行中出现“=?”时添加字符串“Result”，需保证从上到下的处理顺序。移除代码中的MsgBox "Calculating"后程序陷入无限循环，尝试wdCollapseEnd、Application.ScreenUpdating = False及Application.Refresh均无法解决。

原代码如下：

Public Sub TrialParse()
    Dim singleLine As Paragraph
    Dim t As String
    Dim s As String
    Dim lineText As String
    Dim lineNumber As Long
    Dim ParaCol As Long
    Dim ParaRange As Range
    Dim ReplaceText As String
    
    Application.ScreenUpdating = False
    Set Evaluator = New VBAexpressions
    
               'Seperate by lline
            For Each singleLine In ActiveDocument.Paragraphs
                Set ParaRange = singleLine.Range
                lineText = singleLine.Range.Text
                lineNumber = ParaRange.Information(wdFirstCharacterLineNumber)
                ParaCol = ParaRange.Information(wdFirstCharacterColumnNumber)
                
                'seperate by tabs
                tstring = Split(lineText, vbTab)
                For i = LBound(tstring, 1) To UBound(tstring, 1)
                    'find the variable definitions
                    If (tstring(i) <> "") Then
                        If (InStr(tstring(i), "=") > 0 And InStr(tstring(i), "=?") < 1) Then
                              tstring(i) = Replace(tstring(i), " ", "")     'Remove spaces
                              tstring(i) = Replace(tstring(i), vbCr, "")     'Remove Line Return
                              seq = Split(tstring(i), "=")
                              'Call docvariables(CStr(seq(0)), Val(seq(1)))
                        ElseIf (InStr(tstring(i), "=?") > 0) Then   'This is an evaluation point
                            cstring = Split(tstring(i), "=?")
                            
                               ReplaceText = ParaRange.Text & "Result"
                                                            
                                MsgBox "Calculating"
                               
                                ParaRange.Text = ReplaceText
                                
                                   ' Move the range to the next character after the replacement
                               ParaRange.Collapse wdCollapseEnd
               
                        End If
                    End If
                Next i
            Next singleLine
            Application.ScreenUpdating = True
End Sub

问题原因 #

使用For Each singleLine In ActiveDocument.Paragraphs遍历段落时，Word的Paragraphs集合是动态集合。当修改ParaRange.Text添加内容时，Word会自动更新段落结构，导致集合的索引发生变化——比如当前段落修改后，后续段落的位置被后移，循环会重复处理已经处理过的段落，最终引发无限循环。

解决方案 #

方案1：从后往前遍历段落 #

通过倒序遍历段落，修改后面的段落不会影响前面段落的索引，避免循环重复处理。修改后的代码如下：

Public Sub TrialParse_Fix()
    Dim singleLine As Paragraph
    Dim t As String
    Dim s As String
    Dim lineText As String
    Dim lineNumber As Long
    Dim ParaCol As Long
    Dim ParaRange As Range
    Dim ReplaceText As String
    Dim iPara As Long ' 用于倒序遍历的计数器
    
    Application.ScreenUpdating = False
    Set Evaluator = New VBAexpressions
    
    ' 从最后一个段落倒序遍历到第一个
    For iPara = ActiveDocument.Paragraphs.Count To 1 Step -1
        Set singleLine = ActiveDocument.Paragraphs(iPara)
        Set ParaRange = singleLine.Range
        lineText = singleLine.Range.Text
        lineNumber = ParaRange.Information(wdFirstCharacterLineNumber)
        ParaCol = ParaRange.Information(wdFirstCharacterColumnNumber)
        
        'seperate by tabs
        tstring = Split(lineText, vbTab)
        For i = LBound(tstring, 1) To UBound(tstring, 1)
            'find the variable definitions
            If (tstring(i) <> "") Then
                If (InStr(tstring(i), "=") > 0 And InStr(tstring(i), "=?") < 1) Then
                      tstring(i) = Replace(tstring(i), " ", "")     'Remove spaces
                      tstring(i) = Replace(tstring(i), vbCr, "")     'Remove Line Return
                      seq = Split(tstring(i), "=")
                      'Call docvariables(CStr(seq(0)), Val(seq(1)))
                ElseIf (InStr(tstring(i), "=?") > 0) Then   'This is an evaluation point
                    cstring = Split(tstring(i), "=?")
                    
                       ReplaceText = ParaRange.Text & "Result"
                                                
                        ParaRange.Text = ReplaceText
                        
                           ' Move the range to the next character after the replacement
                       ParaRange.Collapse wdCollapseEnd
               
                End If
            End If
        Next i
    Next iPara
    Application.ScreenUpdating = True
End Sub

方案2：将段落存入静态数组后遍历 #

先把所有段落对象存入数组，再遍历数组。数组是静态的，不受Word动态更新段落集合的影响：

Public Sub TrialParse_Fix_Array()
    Dim singleLine As Paragraph
    Dim paraArray() As Paragraph ' 存储段落的数组
    Dim t As String
    Dim s As String
    Dim lineText As String
    Dim lineNumber As Long
    Dim ParaCol As Long
    Dim ParaRange As Range
    Dim ReplaceText As String
    Dim iPara As Long
    
    Application.ScreenUpdating = False
    Set Evaluator = New VBAexpressions
    
    ' 将所有段落存入数组
    ReDim paraArray(1 To ActiveDocument.Paragraphs.Count)
    For iPara = 1 To ActiveDocument.Paragraphs.Count
        Set paraArray(iPara) = ActiveDocument.Paragraphs(iPara)
    Next iPara
    
    ' 遍历数组中的段落
    For Each singleLine In paraArray
        Set ParaRange = singleLine.Range
        lineText = singleLine.Range.Text
        lineNumber = ParaRange.Information(wdFirstCharacterLineNumber)
        ParaCol = ParaRange.Information(wdFirstCharacterColumnNumber)
        
        'seperate by tabs
        tstring = Split(lineText, vbTab)
        For i = LBound(tstring, 1) To UBound(tstring, 1)
            'find the variable definitions
            If (tstring(i) <> "") Then
                If (InStr(tstring(i), "=") > 0 And InStr(tstring(i), "=?") < 1) Then
                      tstring(i) = Replace(tstring(i), " ", "")     'Remove spaces
                      tstring(i) = Replace(tstring(i), vbCr, "")     'Remove Line Return
                      seq = Split(tstring(i), "=")
                      'Call docvariables(CStr(seq(0)), Val(seq(1)))
                ElseIf (InStr(tstring(i), "=?") > 0) Then   'This is an evaluation point
                    cstring = Split(tstring(i), "=?")
                    
                       ReplaceText = ParaRange.Text & "Result"
                                                
                        ParaRange.Text = ReplaceText
                        
                           ' Move the range to the next character after the replacement
                       ParaRange.Collapse wdCollapseEnd
               
                End If
            End If
        Next i
    Next singleLine
    Application.ScreenUpdating = True
End Sub

补充说明 #

两种方案都能避免动态集合的索引问题，建议优先使用从后往前遍历的方式，代码更简洁，性能也更优。

内容的提问来源于stack exchange，提问作者chuber