Replacing equations with text + count

Question

I have a document with Word equation objects and I want to remove them from the document, place them in a new document, and leave a callout with a number in the original document, with a macro. The equations are in-line and on separate lines.

Ex:

Original This is my equation *x=y² *. Here is my second equation: a + b +c

After: This is my equation <Equation 001>. Here is my second equation: <Equation 002>

I have looked at OMaths.Count, Insert, CaptionLabel, Replace, CrossReference, and I can't get any of them to work--I don't know enough to even know what function I would need.

    Sub ReplaceEquationsReference()
    Dim Equation As OMath
    Dim i As Integer
    With ActiveDocument
        .DeleteAllEditableRanges wdEditorEveryone
        For i = 1 To .OMaths.Count
            Set Equation = .OMaths.Item(i)
            Equation.Range.Editors.Add wdEditorEveryone
        Next
        .SelectAllEditableRanges wdEditorEveryone
        .DeleteAllEditableRanges wdEditorEveryone

'Something in here to insert automated text'

        Selection.Cut
        Documents.Add.Content.Paste

    End With
    End Sub

I found a way to add equation captions, which gets me mostly there. But my problem is that I want to the captions to be copied with the equations to a new document.

    Sub ReplaceEquationsReference()
    Dim Equation As OMath
    Dim i As Integer
    With ActiveDocument
    For Each Equation In ActiveDocument.OMaths
        Equation.Range.InsertCaption Label:=wdCaptionEquation
    Next
        .DeleteAllEditableRanges wdEditorEveryone
        For i = 1 To .OMaths.Count
            Set Equation = .OMaths.Item(i)
            Equation.Range.Editors.Add wdEditorEveryone
        Next
        .SelectAllEditableRanges wdEditorEveryone
        .DeleteAllEditableRanges wdEditorEveryone
        Selection.Cut
        Documents.Add.Content.Paste
    'To run InsertCaption Label in new document'

    End With
    End Sub

Answer 1

For a basic facility (copy equations to a new document, label them in the new document and replace the originals with a plain text identifier + sequence number) you could use something like the following. If you need to enable editing via Equation.Range.Editors.Add wdEditorEveryone then you should put the necessary code back in

Sub extractEqs()
Dim docSource As Word.Document
Dim docTarget As Word.Document
Dim eq As Word.OMath
Dim i As Long
Dim rngSource As Word.Range
Dim rngTarget As Word.Range
Dim txtCaption As String

i = 0
Set docSource = ActiveDocument
Set docTarget = Application.Documents.Add("Normal")

For Each eq In docSource.OMaths
  Set rngSource = eq.Range
  Set rngTarget = docTarget.Range(docTarget.Content.End - 1, docTarget.Content.End - 1)
  rngTarget.FormattedText = rngSource.FormattedText
  
  ' add a couple of paras and a caption after each EQ
  docTarget.Content.InsertParagraphAfter
  i = i + 1
  txtCaption = "<Equation " & Right("00" & CStr(i), 3) & ">"
  docTarget.Content.InsertAfter txtCaption
  docTarget.Content.InsertParagraphAfter
  
  ' replace the original equation by the plaintext caption
  rngSource.Delete
  rngSource.Text = txtCaption
Next

docTarget.SaveAs2 "g:\test\eqtarget.docx", WdSaveFormat.wdFormatXMLDocument
docTarget.Close
Set rngSource = Nothing
Set rngTarget = Nothing
Set docTarget = Nothing
Set docSource = Nothing
End Sub

The InsertCaption method inserts a standard caption that contains a { SEQ Equation } field. If you wanted to use a SEQuence field to provide the numbering, the above code can be changed fairly easily to do that.

Otherwise, if you want to copy the Equation and any caption (with caption text) that might exist, you should modify your question and describe where your captions can be found (e.g. are they in a new paragraph after the Equation, in the same paragraph after the Equation and a tab character, or what?)