实现Word公式和普通文本的批量互转

引子

在对Word文档进行翻译时，如果文档中含有公式，翻译软件就会自动跳过，导致翻译出来的句子很奇怪，而如果将公式转换为普通文本之后就可以解决这个问题，所以写了个vb脚本实现Word公式和普通文本的批量互转。

代码

代码主要包含2个方法，

1. 将公式转换为普通文本，转换后的普通文本由\[和\]符号包含，从而支持之后将公式文本转换回公式，也正是由于这个原因，如果文档内包含\[和\]符号的话，这种方法就不太好用了。

Sub 将公式转换为普通文本()
'
' 将公式转换为普通文本 宏
'
'
    Dim MathObj As OMath
    Dim text As String
    ' 记录当前位置
    Dim currentPosition As Range
    Set currentPosition = Selection.Range
    ' 将每个公式转换为文本
    With ActiveDocument
        .DeleteAllEditableRanges wdEditorEveryone
        For Each MathObj In .OMaths
        With MathObj
            .Linearize  ' 线性化
            'ConvertToNormalText    ' 转换为普通文本
            ' 选择公式
            .Range.Editors.Add wdEditorEveryone
            ActiveDocument.SelectAllEditableRanges wdEditorEveryone
            ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
            ' 复制所选内容
            Selection.Copy
            ' 将公式转换为文本
            text = "\[" & Selection.text & "\]"
            
            Selection.text = text
            .Remove
        End With
        Next
    End With
    ' 回到之前的位置
    currentPosition.Select
End Sub

2. 将公式文本转换为公式，检测\[和\]包含的文本，并转换为公式

Sub 将公式文本转换为公式()
'
' 将公式文本转换为公式 宏
'
'
    ' 记录当前位置
    Dim currentPosition As Range
    Set currentPosition = Selection.Range
    ' 定位文档开头
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=0
    ' 循环查找\[*\]字符串, 并将其中包含的文本转换为公式
    Do
        ' 查找
        Selection.Find.ClearFormatting
        With Selection.Find
            .text = "\\\[(*)\\\]"
            .Replacement.text = "\1"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchPrefix = False
            .MatchSuffix = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        ' 如果找到了公式文本就转换为公式
        If Selection.text Like "[\[]*[\]]" Then
            Dim objRange As Range
            Dim objEq As OMath
             
            Set objRange = Selection.Range
            objRange.text = Mid(Selection.text, 3, Selection.Characters.Count - 4)
            Set objRange = Selection.OMaths.Add(objRange)
            Set objEq = objRange.OMaths(1)
            objEq.BuildUp
        Else
            Exit Do
        End If
    Loop
    ' 回到之前的位置
    currentPosition.Select
End Sub