VBA 纯新手，程序可能比较傻，大家将就看。有改进建议，欢迎留言
参考链接：
1、2种办法把MathType公式转换为Word公式
2、一键批量将mathtype公式转换成word自带公式-vba/vbnet_mathtype批量转word自带_一路向前的小Q的博客-CSDN博客
本文主要解决两个新问题：
第一个是：上面两个链接中的程序均会报错：
Run-time error '4198'
Command Failed
但继续执行，程序可以获得正确结果。下面的新程序进行了报错处理。
第二个是：原始文档中会存在一些错误，导致转换失败。新程序对此也进行了处理。
执行步骤：
第一步：还是先将mathtype转换为mathml2，按图操作,注意几个复选框的处理。
第二步：
复制一段mathml2公式，并粘贴。如果是第一次粘贴，会出现如下图所示的提示，请选择“创建一个OMML公式”，并勾选“记住我的选择”，下次粘贴就不会出现这样的提示。
第三步：自动化程序实现
Sub MathML2OMML(k As Integer)
'用k记录总的转换成功数。
On Error GoTo ErrorHandler ' 启用错误处理
Application.ScreenUpdating = False '关闭屏幕刷新
Dim i, j, m As Integer
i = 0 '记录转换的公式总数，失败的也会记录在内
j = 0 '防止死循环用的，记录错误次数
m = 0 '记录转换失败次数With Selection.Find '设置查找表达式，查找转换后的MathML代码.ClearFormatting.Replacement.ClearFormatting.Text = "\<\!-- MathType*5\@ --\>^13" '通配符选择公式，注意mathtype转换时，最后两个复选框要选中.Replacement.Text = "".Forward = True.Wrap = wdFindStop.Format = False.MatchWildcards = TrueSelection.SetRange 0, 0 '回到文首Do While .ExecuteWith Selection.Copy '复制MathML代码.PasteAndFormat (WdRecoveryType.wdFormatPlainText) '无格式粘贴MathML代码End Withi = i + 1 '转换公式数+1Loop
End WithApplication.ScreenUpdating = True '开启屏幕刷新
'MsgBox "新转换成功" & i & "个公式，如数字偏大，建议重复运行"k = k + i - mIf (m > 10 And i - m > 0) ThenCall MathML2OMML(k) '只要失败数超过10，且有新成功的，就重复运行，Elsea = MsgBox("最后一次运行转换失败" & m & "个公式，是否重复运行", vbYesNo)If a = vbYes ThenCall MathML2OMML(k) '选择是，则重复运行ElseMsgBox ("共新转换成功" & k & "个公式")Exit SubEnd IfEnd If'Exit SubErrorHandler: ' 错误处理j = j + 1 '错误出现次数加一If j < 100 ThenResume ' 100次以内直接忽略错误，继续执行Elsej = 0 '防止死循环，跳过一行后，继续执行知道100次错误出现'MsgBox "运行出错"m = m + 1Resume NextEnd IfEnd SubSub 公式转换()
Call MathML2OMML(0)
End Sub
