MathType转Word公式(OMML)

背景

由于之前个人喜欢在Word里做笔记，而有很多笔记里存在着大量的公式。在早期，由于对Word自身的公式的不理解，所以便使用了MathType这个工具来编写公式。但是现在本人已经转战到LatTeX了（现在用LyTeX来做笔记），需要把之前的笔记转到LyTeX(LaTeX)下。

做为了一折腾电脑的人，我当然不可能把之前的内容全部手打一遍，所以结合自己的知识、百度搜索和对LyTeX的调教，发现可以直接由Word转换为LyX（LyTeX的源文件），其内核是使用Pandoc先将Word转为LaTeX的源文件(*.tex)，再由LyTeX调用一个Python脚本文件，将tex文件转换为lyx文件。

然后，实际上没有那么简单。因为pandoc不支持OLE版本的公式（即MathType默认的嵌入方式）转换，仅支持Word自带的公式（由Equation Editor 6.0创建的OMML公式）转换，所以需要将MathType转换为OMML公式。那么问题来了，如何办呢？

在百度找到的一个最简单的方法是GrindEQ这个软件来进行转换，但是由于这个是收费软件，小弟我没有钱啊，所以就放弃了。

终于，让我在博客把word中的Mathtype公式转换为OMML公式中找到了一个解决方法。但是由于博客中的内容不完整，所以在折腾好几个小时之后终于成功。（其实第一次看到没有折腾成功，在今天又花了好几个小时来折腾，终于成功了）下面就放出来和大家分享。

实现基础

要求：

• MathType
• Word 2013/2016(10应该也可以，没有尝试)

首先，我们将下面一段文字复制到Word里粘贴，〔如果你有安装MathType的话，会提示你粘贴为MathType自带的OLE格式还是Word自身的OMML格式，具体的我记不清楚了，你选择OMML那个再确定就好〕会有神奇的事情发生：

<math xmlns='http://www.w3.org/1998/Math/MathML'> <mrow> <msqrt> <mrow> <msup> <mi>x</mi> <mn>2</mn> </msup> <mo>+</mo><msup> <mi>y</mi> <mn>2</mn> </msup> </mrow> </msqrt> </mrow> </math>

嗯，个人不喜欢配图，所以大家自己上Word吧，「自己动手，丰衣足食」，嘻嘻。

〔在这里，我假设你已经完成了上面的尝试〕

我们可以看到，上面的文件变成了Word自带的OMML公式，这个就是我们需要的内容。那么，上面的内容如何来呢？接着往下看。

根据先验知识(感觉概念论里的这个名称很好用，用没有，反正把锅都扔了，不关我的事儿)，MathType里面有一个公式转换【MathType→Format→Convert Equations...】，这个可以把公式转为多种格式，这个就是我们今天需要使用的大杀器。

所以我们打开包含MathType公式（OLE公式）的文档，【MathType→Format→Convert Equations...】，在弹出的对话框里左侧勾选：

• MathType or Equation Editor equations
• Microsoft Word EQ fields

右侧选择：【Text using MathType translator:→MathML 2.0 (namespace attr)】「这儿是最主要的」

当然，下面的当前选择还是全文档看你自己的需要喽。

比如：

这个就是转换前后的对比。接下来就是把这个文字转换为OMML公式啦。

VBA编写

有了上面的基础，我们可以把上面的公式【选中→复制→粘贴为纯文本】，全手工操作。但是机智如我，怎么可能用这么笨的办法呢？于是我们的VBA大法来了。参见把word中的Mathtype公式转换为OMML公式

具体的实现就不说了，直接上代码：

Sub PlainMathMLToEquation()
    Dim xmlns As String, mathText As String
    xmlns = "xmlns=""http://www.w3.org/1998/Math/MathML"""
    
    ' set up find parameters
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "\<math?*\</math\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Debug.Print "-------------<Start>-------------------"
    Selection.SetRange 0, 0
    While Selection.Find.Execute()
        CopyPlainText
        Waiting
        Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
    Wend
    Debug.Print "-------------<Finished>-------------------"


End Sub
' Waiting for sometime
Sub Waiting()
    Dim t As Single
    t = Timer
    Do
        DoEvents
    Loop While Timer - t < 0.07 ' enlarger here if error 4605 happens
End Sub
Sub CopyPlainText()
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
       .SetText Selection.Text
       .PutInClipboard
End With
End Sub

运行上面的PlainMathMLToEquation()宏，如果提示

运行时错误 '4605':

此方法或属性无效，因为 剪贴板是空的或无效的。

只需要将Waiting()子过程中的数值增大即可。

为了方便大家使用，我另外制作了ConvertEq.docm，大家可以使用这个文档来完成相应的转换。流程如下：

1. 打开ConvertEq.docm，会在顶部提示宏安全，启用即可，你可以自己打开宏来看看代码；

2. 将需要转换的内容复制到这个文档中；

3. 使用MathType将OLE转换为MathML 2.0 (namespace attr)；

4. 在Word顶端的自定义工具栏中点击下面的按钮即可。

你的顶端工具栏和我的可以不一样，但是你把鼠标放上去，会提示PlainMathMLToEquation这样的字样，那么，就是这个按钮了。

5. 转换结束后拷贝回原文档即可。

源码及模板在：链接: https://pan.baidu.com/s/1MqhxinKLmWX7dTfaJsm5lA 提取码: 5j5u

---

2020-08-04 添加

有两位读者在使用过程中遇到了以下情况，在使用上面的转换方法时，Word总在处理第一个公式，而不会跳转到下一个公式。

感谢@孙浚杰 的提醒，这个是由于在Word的选项里，没有勾选「Word选项」→「高级」→「编辑选项」→「键入内容替换所选文字」一项而导致的。

所以，现在有以下两个方案可以解决。

1. 选项上面的选项。

2. 修改代码为：

Sub PlainMathMLToEquation()
    Dim xmlns As String, mathText As String
    xmlns = "xmlns=""http://www.w3.org/1998/Math/MathML"""
    
    ' set up find parameters
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "\<math?*\</math\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Debug.Print "-------------<Start>-------------------"
    Selection.SetRange 0, 0
    While Selection.Find.Execute()
        CopyPlainText
        ' Delete the selection content after copy.
        Selection.Delete
        Waiting
        Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
    Wend
    Debug.Print "-------------<Finished>-------------------"
End Sub
' Waiting for sometime
Sub Waiting()
    Dim t As Single
    t = Timer
    Do
        DoEvents
    Loop While Timer - t < 0.07 ' enlarger here if error 4605 happens
End Sub
Sub CopyPlainText()
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
       .SetText Selection.Text
       .PutInClipboard
End With
End Sub