前提是：你手动选中 $...$ / $$... $$ 后按 Alt+\ 确实可以由 MathType 转换成功。宏本身不负责解析 TeX 成公式，而是负责：

1. 扫描 Word 正文；
2. 识别 Markdown/LaTeX 风格公式；
3. 从后往前逐个选中；
4. 模拟按下 Alt+\，让 MathType 执行转换。

执行这个宏需要

1. 按下alt+F11启动vb界面
2. 左侧工程-project选择你的文档
3. 上方工具栏，工具-引用，把MathtypeCommand引用进来到你的文档
4. 右键工程-project选择你的文档，插入-模块。
5. 粘贴下面的代码，然后执行

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Public Sub ConvertMarkdownMathToMathType()
    Dim doc As Document
    Dim txt As String
    Dim re As Object
    Dim matches As Object
    Dim m As Object
    Dim rng As Range
    Dim i As Long
    Dim converted As Long
    Dim skipped As Long
    Dim waitMs As Long
    
    ' 每次按 Alt+\ 后等待 MathType 转换的时间
    ' 如果公式多或 MathType 反应慢，可以调大到 800 / 1000 / 1500
    waitMs = 500
    
    Set doc = ActiveDocument
    txt = doc.Content.Text
    
    Set re = CreateObject("VBScript.RegExp")
    
    With re
        .Global = True
        .Multiline = True
        .IgnoreCase = False
        
        ' 识别：
        '   $$...$$
        '   \[...\]
        '   $...$
        '   \(...\)
        '
        ' 单 $...$ 不跨行，$$...$$ 和 \[...\] 可以跨行
        .Pattern = "\$\$[\s\S]+?\$\$|\\\[[\s\S]+?\\\]|\$(?!\$)(\\.|[^\$\\\r\n])+?\$|\\\((\\.|[^\r\n])*?\\\)"
    End With
    
    Set matches = re.Execute(txt)
    
    If matches.Count = 0 Then
        MsgBox "没有找到符合规则的公式。", vbInformation
        Exit Sub
    End If
    
    If MsgBox( _
        "找到 " & matches.Count & " 个候选公式。" & vbCrLf & vbCrLf & _
        "宏将从后往前逐个选中并发送 Alt+\ 给 MathType。" & vbCrLf & _
        "建议先备份文档，运行过程中不要操作键盘和鼠标。" & vbCrLf & vbCrLf & _
        "是否继续？", _
        vbOKCancel + vbQuestion, _
        "Markdown 公式转 MathType" _
    ) <> vbOK Then
        Exit Sub
    End If
    
    Application.Activate
    
    ' 必须从后往前处理，避免前面的字符位置因为后面的替换而失效
    For i = matches.Count - 1 To 0 Step -1
        Set m = matches.Item(i)
        
        If ShouldSkipMatch(txt, CLng(m.FirstIndex), CStr(m.Value)) Then
            skipped = skipped + 1
        Else
            Set rng = doc.Range( _
                doc.Content.Start + CLng(m.FirstIndex), _
                doc.Content.Start + CLng(m.FirstIndex) + Len(CStr(m.Value)) _
            )
            
            rng.Select
            DoEvents
            
            ' 模拟按下 Alt+\
            SendKeys "%\", True
            
            ' 等待 MathType 处理
            Sleep waitMs
            DoEvents
            
            converted = converted + 1
            Application.StatusBar = "正在转换 MathType 公式：" & converted & " / " & matches.Count
        End If
    Next i
    
    Application.StatusBar = False
    
    MsgBox "完成。" & vbCrLf & _
           "发送转换：" & converted & " 个" & vbCrLf & _
           "跳过：" & skipped & " 个", _
           vbInformation
End Sub

Private Function ShouldSkipMatch(ByVal allText As String, ByVal firstIndex0 As Long, ByVal s As String) As Boolean
    ' 跳过被反斜杠转义的开头，例如 \$x$
    If IsEscapedAt(allText, firstIndex0) Then
        ShouldSkipMatch = True
        Exit Function
    End If
    
    ' 对单 $...$ 做一点简单 Markdown 规则过滤：
    ' $ 后面不应该是空白，结尾 $ 前面也不应该是空白
    If Left$(s, 1) = "$" And Left$(s, 2) <> "$$" Then
        If Len(s) < 3 Then
            ShouldSkipMatch = True
            Exit Function
        End If
        
        If IsWhite(Mid$(s, 2, 1)) Or IsWhite(Mid$(s, Len(s) - 1, 1)) Then
            ShouldSkipMatch = True
            Exit Function
        End If
    End If
End Function

Private Function IsEscapedAt(ByVal allText As String, ByVal firstIndex0 As Long) As Boolean
    Dim pos As Long
    Dim cnt As Long
    
    ' firstIndex0 是 0-based；
    ' Mid$ 是 1-based；
    ' 所以前一个字符的位置刚好是 firstIndex0
    pos = firstIndex0
    
    Do While pos >= 1 And Mid$(allText, pos, 1) = "\"
        cnt = cnt + 1
        pos = pos - 1
    Loop
    
    IsEscapedAt = (cnt Mod 2 = 1)
End Function

Private Function IsWhite(ByVal ch As String) As Boolean
    IsWhite = _
        ch = " " Or _
        ch = vbTab Or _
        ch = vbCr Or _
        ch = vbLf Or _
        ch = ChrW(160)
End Function

2026年7月21日