Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Convert formula in a word document to image with macro

I have this macro to convert all shapes in the document to an image :

Dim i As Integer, oShp As Shape

For i = ActiveDocument.Shapes.Count To 1 Step -1
    Set oShp = ActiveDocument.Shapes(i)
    oShp.Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, dataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
Next i

But I want to convert all math formulas to image. How can I change this macro to do this? enter image description here

UPDATE:
I tried this code but doesnt work : (No error and also no result)

Sub AllEquationToPic()
Dim z As Integer, equation As OMath

For z = ActiveDocument.InlineShapes.Count To 1 Step -1
    Set equation = ActiveDocument.OMaths(z)
        equation.Range.Select
        Selection.Cut
        Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
            Placement:=wdInLine, DisplayAsIcon:=False
Next z
End Sub
like image 203
YFeizi Avatar asked Feb 09 '23 12:02

YFeizi


2 Answers

You are iterating through the InlineShapes collection but using z to access the OMaths collection. That's nonsense. Try this then:

Sub AllEquationToPic()
Dim z As Integer, equation As OMath

For z = ActiveDocument.OMaths.Count To 1 Step -1
    Set equation = ActiveDocument.OMaths(z)
        equation.Range.Select
        Selection.Cut
        Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
            Placement:=wdInLine, DisplayAsIcon:=False
Next z
End Sub

Edit: Here is an alternative that works better with inline formulae albeit with slightly worse resulting image quality:

Sub FormulaDoc2PicDoc()
Dim doc As Document, docPath As String, htmPath As String
Dim alertStatus

alertStatus = Application.DisplayAlerts
Application.DisplayAlerts = wdAlertsNone

Set doc = ActiveDocument
docPath = doc.FullName
htmPath = docPath & ".htm"

doc.SaveAs htmPath, wdFormatFilteredHTML
doc.Close False

Application.DisplayAlerts = alertStatus

Set doc = Documents.Open(htmPath, False)

End Sub
like image 176
LocEngineer Avatar answered Feb 12 '23 02:02

LocEngineer


Try the other values for DataType

  • wdPasteBitmap
  • wdPasteDeviceIndependentBitmap
  • wdPasteEnhancedMetafile
  • wdPasteHTML
  • wdPasteHyperlink
  • wdPasteMetafilePicture
  • wdPasteOLEObject
  • wdPasteRTF
  • wdPasteShape
  • wdPasteText
like image 35
Justin Dearing Avatar answered Feb 12 '23 00:02

Justin Dearing