Sub ExtractAndReplaceMathML_ThenSaveRTF()
    On Error GoTo ErrorHandler

    ' === [1] Работаем с открытым документом ===
    Dim oDoc As Object
    oDoc = ThisComponent

    If oDoc Is Nothing Then
        MsgBox "Документ не открыт!", 16, "Ошибка"
        Exit Sub
    End If

    If Not oDoc.SupportsService("com.sun.star.text.TextDocument") Then
        MsgBox "Только для документов Writer!", 16, "Ошибка"
        Exit Sub
    End If

    ' Получение пути к файлу
    Dim fileURL As String
    fileURL = oDoc.getURL()
    If fileURL = "" Then
        MsgBox "Сначала сохраните документ на диск!", 16, "Ошибка"
        Exit Sub
    End If

    Dim filePath As String
    filePath = ConvertFromURL(fileURL)

    ' === [2] Готовим папку для формул ===
    Dim folderPath As String
    folderPath = Left(filePath, MyInStrRev(filePath, ".")) & "Formulas MathML"

    Dim oFA As Object
    oFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")

    Dim folderURL As String
    folderURL = ConvertToURL(folderPath)
    If Not oFA.exists(folderURL) Then
        oFA.createFolder(folderURL)
    End If

    ' === [3] Сохраняем документ во временный .fodt ===
    Dim tempFodtPath As String
    tempFodtPath = Left(filePath, MyInStrRev(filePath, ".")) & "temp.fodt"
    Dim tempFodtURL As String
    tempFodtURL = ConvertToURL(tempFodtPath)

    Dim aProps(1) As New com.sun.star.beans.PropertyValue
    aProps(0).Name = "FilterName": aProps(0).Value = "OpenDocument Text Flat XML"
    aProps(1).Name = "Overwrite": aProps(1).Value = True

    oDoc.storeToURL(tempFodtURL, aProps())

    ' === [4] Читаем .fodt и обрабатываем формулы ===
    Dim oStreamIn As Object
    oStreamIn = oFA.openFileRead(tempFodtURL)

    Dim oTextInput As Object
    oTextInput = createUnoService("com.sun.star.io.TextInputStream")
    oTextInput.setInputStream(oStreamIn)

    Dim content As String
    content = ""
    Do While Not oTextInput.isEOF()
        content = content & oTextInput.readLine() & Chr(10)
    Loop
    oTextInput.closeInput()

    Dim iStart As Long, iEnd As Long
    Dim n As Long: n = 1
    Const startMarker = "<math xmlns=""http://www.w3.org/1998/Math/MathML"""
    Const endMarker = "</math>"

    Do
        iStart = InStr(content, startMarker)
        If iStart = 0 Then Exit Do
        iEnd = InStr(iStart, content, endMarker)
        If iEnd = 0 Then Exit Do
        iEnd = iEnd + Len(endMarker) - 1

        Dim sFormula As String
        sFormula = Mid(content, iStart, iEnd - iStart + 1)

        Dim eqnName As String
        eqnName = "Eqn" & Format(n, "0000")

        Dim formulaPath As String
        formulaPath = folderPath & "/" & eqnName & ".html"
        SaveTextToFile sFormula, formulaPath

        content = Left(content, iStart - 1) & "<<" & eqnName & ">>" & Mid(content, iEnd + 1)

        n = n + 1
    Loop

    ' === [5] Заменяем формулы в документе ===
    oDoc.lockControllers()
    Dim bLocked As Boolean: bLocked = True

    Dim oObjects As Object
    oObjects = oDoc.getEmbeddedObjects()

    Dim sFormulaCLSID As String
    sFormulaCLSID = "078B7ABA-54FC-457F-8551-6147e776a997"

    Dim aFormulaNames() As String
    ReDim aFormulaNames(0)
    Dim iFormulaCount As Long: iFormulaCount = 0

    Dim i As Long
    For i = 0 To oObjects.Count - 1
        Dim oObj As Object
        oObj = oObjects.getByIndex(i)
        If oObj.CLSID = sFormulaCLSID Then
            ReDim Preserve aFormulaNames(iFormulaCount)
            aFormulaNames(iFormulaCount) = oObjects.ElementNames(i)
            iFormulaCount = iFormulaCount + 1
        End If
    Next i

    Dim sLabel As String
    For i = UBound(aFormulaNames) To 0 Step -1
        Dim oFormula As Object
        oFormula = oObjects.getByName(aFormulaNames(i))

        ' Используем правильную нумерацию для обратного порядка
        sLabel = " <<Eqn" & Format(UBound(aFormulaNames) - i + 1, "0000") & ">> "

        Dim oCursor As Object
        oCursor = oDoc.Text.createTextCursorByRange(oFormula.Anchor)
        oCursor.String = sLabel

        oDoc.Text.removeTextContent(oFormula)
    Next i

    ' === [6] Сохраняем как RTF ===
    Dim rtfPath As String
    rtfPath = Left(filePath, MyInStrRev(filePath, ".")) & "rtf"
    Dim aRTFProps(1) As New com.sun.star.beans.PropertyValue
    aRTFProps(0).Name = "FilterName": aRTFProps(0).Value = "Rich Text Format"
    aRTFProps(1).Name = "Overwrite": aRTFProps(1).Value = True

    oDoc.storeToURL(ConvertToURL(rtfPath), aRTFProps())

    ' === [7] Завершение ===
    If bLocked Then oDoc.unlockControllers()

    MsgBox "Извлечено " & (n - 1) & " формул в папку:" & Chr(10) & _
           folderPath & Chr(10) & _
           "Итоговый файл сохранён как:" & Chr(10) & _
           ExtractFileName(rtfPath), 64, "Готово"

    Exit Sub

ErrorHandler:
    MsgBox "Ошибка " & Err() & ": " & Error$(), 16, "Сбой"
    If bLocked Then oDoc.unlockControllers()
End Sub

' === Вспомогательные функции ===

Sub SaveTextToFile(ByVal text As String, ByVal filePath As String)
    Dim oFA As Object
    oFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")

    Dim oStream As Object
    oStream = createUnoService("com.sun.star.io.TextOutputStream")
    Dim oOutFile As Object
    oOutFile = oFA.openFileWrite(ConvertToURL(filePath))

    oStream.setOutputStream(oOutFile)
    oStream.writeString(text)
    oStream.closeOutput()
End Sub

Function MyInStrRev(sText As String, sFind As String) As Long
    Dim i As Long
    For i = Len(sText) - Len(sFind) + 1 To 1 Step -1
        If Mid(sText, i, Len(sFind)) = sFind Then
            MyInStrRev = i
            Exit Function
        End If
    Next
    MyInStrRev = 0
End Function

Function ExtractFileName(sURL As String) As String
    Dim i As Long
    For i = Len(sURL) To 1 Step -1
        If Mid(sURL, i, 1) = "/" Then
            ExtractFileName = Mid(sURL, i + 1)
            Exit Function
        End If
    Next
    ExtractFileName = sURL
End Function
