Mac版Word専用。Word文書内の数式をMathMLファイルに保存し、連番テキストに置き換えるマクロ

ExportAndReplaceEquations.vb

Sub ExportAndReplaceEquations()
    '
    ' Mac版Word専用
    ' Word文書内の数式をMathMLファイルに保存し、連番テキストに置き換えるマクロ
    '
    ' 注意：Wordの数式オプションで「MathMLをテキストとしてクリップボードにコピーする」に設定する必要があります
    

    ' 画面更新を無効
    Application.ScreenUpdating = False
    
    On Error GoTo ErrorHandler
    
    Dim doc As Document
    Dim oMath As oMath
    Dim mathRange As Range
    Dim mathMLContent As String
    Dim fileName As String
    Dim filePath As String
    Dim fileNum As Integer
    Dim equationCount As Integer
    Dim i As Integer
    Dim replacementText As String
    
    ' 現在のドキュメントを取得
    Set doc = ActiveDocument
    
    ' 数式の数をカウント
    equationCount = doc.OMaths.count
    
    ' 数式が存在しない場合の処理
    If equationCount = 0 Then
        MsgBox "このドキュメントには数式が見つかりませんでした。", vbInformation, "数式処理"
        Exit Sub
    End If
    
    ' 確認メッセージ
    Dim response As Integer
    response = MsgBox("文書内の " & equationCount & " 個の数式を処理します：" & vbCrLf & _
                     "1. MathMLファイルとして保存" & vbCr & _
                     "2. 連番テキストに置き換え", vbYesNo + vbQuestion, "数式処理の確認")
    
    If response = vbNo Then
        Exit Sub
    End If
    
    ' 保存先フォルダを選択
    Dim savePath As String
    On Error Resume Next
    savePath = MacScript("return POSIX path of (choose folder with prompt ""数式ファイルの保存先フォルダを選択してください"")")
    
    ' フォルダ選択がキャンセルされた場合の処理
    If Err.Number <> 0 Or savePath = "" Then
        Err.Clear
        MsgBox "フォルダ選択がキャンセルされました。処理を中止します。", vbInformation, "処理中止"
        Exit Sub
    End If
    On Error GoTo 0
    
    ' パスの末尾のスラッシュを削除
    If Right(savePath, 1) = "/" Then
        savePath = Left(savePath, Len(savePath) - 1)
    End If
    
    ' Phase 1: MathMLファイルとして保存
    For i = 1 To equationCount
        Set oMath = doc.OMaths(i)
        
        ' 連番ファイル名を生成（3桁の0埋め）
        fileName = "equation_" & Format(i, "000") & ".txt"
        filePath = savePath & "/" & fileName
        
        ' ファイル番号を取得
        fileNum = FreeFile
        
        ' テキストファイルを作成
        Open filePath For Output As #fileNum
        
        ' 数式をコピーしてクリップボードからMathMLを取得
        oMath.Range.Select
        oMath.Range.Copy
        
        ' クリップボードからMathMLテキストを取得
        On Error Resume Next
        mathMLContent = ""
        
        ' MacScriptでクリップボードから取得
        mathMLContent = MacScript("the clipboard as string")
        
        ' MathMLが取得できない場合の代替処理
        If mathMLContent = "" Or Err.Number <> 0 Then
            Err.Clear
            mathMLContent = "クリップボードが空でした。"
        End If
        
        On Error GoTo 0
        
        ' クリップボードから取得したテキストを保存
        Print #fileNum, mathMLContent
        
        ' ファイルを閉じる
        Close #fileNum
        
    Next i
    
    ' Phase 2: 数式エディタを削除して連番テキストに置き換え（後ろから処理）
    For i = equationCount To 1 Step -1
        Set oMath = doc.OMaths(i)
        Set mathRange = oMath.Range
        
        ' 置換テキストを生成（3桁の0埋め）
        replacementText = "equation_" & Format(i, "000")
        
        ' 数式エディタを選択して削除し、普通のテキストを挿入
        mathRange.Select
        Selection.Delete
        Selection.TypeText replacementText
        
    Next i
    
    ' 完了メッセージ
    MsgBox "処理した数式数: " & equationCount, vbInformation, "処理完了"
    
    ' 画面更新を元に戻す
    Application.ScreenUpdating = True
    Exit Sub
    
ErrorHandler:
    ' エラーが発生した場合も画面更新を元に戻す
    Application.ScreenUpdating = True
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "エラー"
    
End Sub