Word阿拉伯语文本格式化VBA宏运行不稳定问题求助

原有代码核心问题 #

• 混合语言段落判断逻辑错误：你使用的9999999不是Word官方定义的混合语言常量，大量混合语言段落无法命中第一个判断分支，导致逻辑跑错
• 双向文字字体设置缺失：阿拉伯语属于从右到左（BiDi）文种，Word单独使用Font.NameBi属性存储这类文种的字体配置，仅设置Font.Name不会生效，连带字号设置也会因字体匹配失败失效
• 纯非英文段落判断不准：直接判断段落整体LanguageID不等于英文的逻辑，会被段落中的空格、标点、隐藏格式干扰，经常无法命中第二个分支，导致右对齐不生效
• Words集合遍历有坑：Word的Words集合会将空格、标点单独识别为独立对象，这类对象的语言属性判断误差极大，会漏掉大量非英文文本的格式设置
• 变量未显式声明，容易因变量类型不匹配导致运行异常

修正后可稳定运行的代码 #

Sub Arabic()
    Dim myPara As Paragraph
    Dim myRange As Range
    Dim isAllNonEnglish As Boolean
    
    ' 关闭屏幕更新提升运行速度，避免卡顿
    Application.ScreenUpdating = False
    
    For Each myPara In ActiveDocument.Paragraphs
        isAllNonEnglish = True
        ' 先遍历整个段落判断是否存在英文
        For Each myRange In myPara.Range.Words
            ' 跳过空白内容和标点的判断
            If Trim(myRange.Text) <> "" And Not IsPunctuation(Trim(myRange.Text)) Then
                If myRange.LanguageID = wdEnglishUS Then
                    isAllNonEnglish = False
                    Exit For
                End If
            End If
        Next myRange
        
        If isAllNonEnglish Then
            ' 纯非英文段落处理逻辑
            With myPara.Range
                .Font.NameBi = "Noto Naskh Arabic UI"
                .Font.SizeBi = 18
                .Font.Name = "Noto Naskh Arabic UI"
                .Font.Size = 18
            End With
            myPara.Alignment = wdAlignParagraphRight
        Else
            ' 混合语言段落处理逻辑
            For Each myRange In myPara.Range.Words
                If Trim(myRange.Text) <> "" And Not IsPunctuation(Trim(myRange.Text)) Then
                    If myRange.LanguageID <> wdEnglishUS Then
                        With myRange.Font
                            .NameBi = "Noto Naskh Arabic UI"
                            .SizeBi = 18
                            .Name = "Noto Naskh Arabic UI"
                            .Size = 18
                        End With
                    Else
                        myRange.Font.Name = "Times New Roman"
                    End If
                End If
            Next myRange
        End If
    Next myPara
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

' 辅助函数：判断是否为标点符号
Function IsPunctuation(str As String) As Boolean
    Dim punctuations As String
    punctuations = "，。、；：“”‘’（）【】！？,.;:\""'()[]{}?! " & vbCr & vbTab
    IsPunctuation = (InStr(punctuations, str) > 0)
End Function

关键修改说明 #

• 新增先遍历判断段落是否全为非英文的逻辑，避免原有LanguageID整体判断的误差，右对齐逻辑可100%触发
• 同时设置Font.Name/Font.Size和Font.NameBi/Font.SizeBi，适配双向文种的Word格式存储规则，字体和字号可稳定生效
• 新增空白内容、标点过滤逻辑，避免无效内容干扰语言判断，不会再漏改文本格式
• 新增屏幕更新关闭逻辑，大文档运行时不会卡顿，速度提升明显
• 所有变量显式声明，消除类型不匹配导致的不稳定问题

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