vbamathms-wordequations

oMath from excel to word


I am creating a word report through excel VBA. I need math equation to be written but unfortunately, the word document do not autocorrect \pi and \times. Otherwise the equation is printed. Can someone suggest me what is the way forward. Below is the code

Sub AreaSolidBolt(wrdApp As Object, wrdDoc As Object, d As Variant)
Dim objRange As Object
Dim objEq As OMath
Dim aCorrect As OMathAutoCorrectEntry
wrdApp.OMathAutoCorrect.UseOutsideOMath = True

Set objRange = wrdDoc.Range
objRange.Text = "A = \pi/4 \times d^2"
Set objRange = wrdApp.Selection.OMaths.Add(objRange)
    For Each aCorrect In wrdApp.OMathAutoCorrect.Entries
        With objRange
            If InStr(.Text, aCorrect.Name) > 0 Then
                .Text = Replace(.Text, aCorrect.Name, aCorrect.Value)
            End If
        End With
    Next aCorrect
Set objEq = objRange.OMaths(1)
objEq.BuildUp

Set objRange = Nothing
End Sub

I have defined the objects as below in the calling function. Can you please suggest me the way forward.

Set fso = CreateObject("Scripting.FileSystemObject")
Set wrdApp = CreateObject("Word.Application")

If Not fso.FileExists(wrdFileName) Then
    Set wrdDoc = wrdApp.Documents.Add
    wrdApp.Visible = False
    With wrdDoc
        .SaveAs FileName:=wrdFileName
    End With
Else
    Set wrdDoc = wrdApp.Documents.Open(wrdFileName)
    wrdApp.Visible = False
    wrdDoc.Content.InsertAfter vbLf
End If

Solution

  • I have found the answer myself. The was slightly modified. The error was with the placement of the code line Set objRange = wrdApp.Selection.OMaths.Add(objRange)

    Below is the modified code.

    Sub AreaSolidBolt(wrdApp As Object, wrdDoc As Object, d As Variant)
    Dim objRange As Object
    Dim objEq As OMath
    Dim aCorrect As OMathAutoCorrectEntry
    wrdApp.OMathAutoCorrect.UseOutsideOMath = True
    
    Set objRange = wrdDoc.Range
    objRange.Text = "A = \pi/4 \times d^2"
    For Each aCorrect In wrdApp.OMathAutoCorrect.Entries
       With objRange
          If InStr(.Text, aCorrect.Name) > 0 Then
              .Text = Replace(.Text, aCorrect.Name, aCorrect.Value)
           End If
       End With
    Next aCorrect
    Set objRange = wrdApp.Selection.OMaths.Add(objRange)
    Set objEq = objRange.OMaths(1)
    objEq.BuildUp
    
    Set objRange = Nothing
    End Sub