Mac端Word VBA宏无限加载无法执行问题排查求助

宏功能概述 #

• 添加富文本内容控件（Rich Text Content Control）
• 为富文本内容控件设置tag/title
• 编辑现有富文本内容控件的tag/title
• 删除所有tag不含“Me”的富文本内容控件，并同步删除控件所在页面以避免空白

问题描述 #

在仅10页的测试文档中运行宏时，出现无限加载的旋转轮，宏始终无法执行完成。

环境信息 #

• 设备：2021款M1 MacBook Pro
• 系统：MacOS Monterey 12.6.8
• Office版本：Office Home & Business 2021

宏代码 #

Sub A_A_AddRichTextControl()
    Dim rngSelection As Range
    
    Set rngSelection = Selection.Range
    ActiveDocument.ContentControls.Add Type:=wdContentControlRichText, Range:=rngSelection
End Sub


Sub A_B_EditTagAndTitleOfRichTextControl()
    Dim cc As ContentControl
    Dim newTag As String
    
    If Selection.Range.ContentControls.Count = 1 Then
        Set cc = Selection.Range.ContentControls(1)
        
        ' Prompt for new tag
        newTag = InputBox("Enter new tag for the rich text content control:", "New Tag")
        
        ' Set new tag and title
        If newTag <> "" Then
            cc.tag = newTag
            cc.Title = newTag ' Set title equal to the tag
        End If
    Else
        MsgBox "Select a single rich text content control to edit tag and title.", vbExclamation
    End If
End Sub


Sub A_C_EditContentControlTagAndTitle()
    Dim cc As ContentControl
    Dim newTag As String
    
    ' Check if the selection contains a content control
    If Selection.Range.ContentControls.Count > 0 Then
        ' Store a reference to the first content control in the selection
        Set cc = Selection.Range.ContentControls(1)
        
        ' Prompt the user for new tag and title values
        newTag = InputBox("Enter the content control property tag:", "Edit Tag", cc.tag)
        
        ' Update the tag and title
        cc.tag = newTag
        cc.Title = newTag
        
        ' Optional: Refresh the content control to apply changes
        cc.LockContentControl = True
        cc.LockContentControl = False
    Else
        MsgBox "Please select a content control before running this macro.", vbExclamation
    End If
End Sub


Sub B_A_RemoveRT_ExceptMe()
    Dim oCC As ContentControl
    Dim arrTagParts() As String
    Dim lngIndex As Long
    Dim bDelete As Boolean
    Dim oPage As Range

    For Each oCC In ActiveDocument.ContentControls
        bDelete = True
        If oCC.Type = 0 Then 'wdContentControlText
            arrTagParts = Split(oCC.tag, " ")
            For lngIndex = 0 To UBound(arrTagParts)
                If arrTagParts(lngIndex) = "Me" Then
                    bDelete = False
                    Exit For
                End If
            Next lngIndex
            If bDelete Then
                ' Get the page range of the content control
                Set oPage = oCC.Range.GoTo(wdGoToPage, wdGoToAbsolute, oCC.Range.Information(wdActiveEndPageNumber))
                ' Delete the content control
                oCC.Delete True
                ' Delete the entire page
                oPage.Delete
            End If
        End If
    Next oCC
lbl_Exit:
    Exit Sub
End Sub

可能的问题原因 #

1. 遍历集合时修改集合导致逻辑混乱
   使用For Each遍历ActiveDocument.ContentControls集合的同时，在循环内执行oCC.Delete删除控件，会直接改变集合的结构，导致遍历指针无法正常推进，甚至出现无限循环。

2. 页面删除引发的页码错乱
   删除页面后，文档的页码会动态变化（比如删除第3页后，原第4页会变成新的第3页），后续循环中通过oCC.Range.Information(wdActiveEndPageNumber)获取的页码会失真，可能导致重复删除同一页面或尝试删除不存在的页面，引发卡顿。

3. Mac版Office VBA兼容性问题
   M1芯片Mac上的Office 2021 VBA引擎，对ContentControls集合遍历、Range.GoTo等操作可能存在兼容性问题，导致执行效率极低甚至卡死。

4. 控件类型判断错误
   代码中用oCC.Type = 0判断文本控件，但需求是处理富文本控件（对应值为wdContentControlRichText即2），这会导致代码错误处理非目标控件，引发不必要的循环操作。

修复建议 #

1. 反向遍历集合
   改为从最后一个控件向前遍历，避免修改集合影响遍历逻辑：

   Dim i As Long
   For i = ActiveDocument.ContentControls.Count To 1 Step -1
       Set oCC = ActiveDocument.ContentControls(i)
       ' 后续判断和删除逻辑不变
   Next i
   

2. 修正控件类型判断
   将If oCC.Type = 0 Then改为If oCC.Type = wdContentControlRichText Then，确保只处理富文本控件。

3. 优化页面删除逻辑
   先收集所有需要删除的页面范围，最后一次性删除；或者删除控件后检查页面内容是否为空，再决定是否删除页面，避免页码变化带来的错误。

4. 关闭屏幕更新
   在宏开头添加Application.ScreenUpdating = False，结尾添加Application.ScreenUpdating = True，减少界面刷新的性能损耗。

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