CODEWITHSUNDEEP
excelvbams-word
Geddes
Geddes

Reputation: 123

trouble pasting a Word equation into Excel

I want to paste equations from Word into Excel 2007. The following Excel VBA code achieves this:

Sub ExpandEqn(MyText As String)

Dim appWd As Word.Application
Dim docWd As Word.Document
Dim objRange As Word.Range
Dim objEq As OMath

Set FindActiveCell = Application.ActiveCell
GetRange = CStr(FindActiveCell.Address())
ActiveCell.Offset(1, 0).Activate
NextActiveCell = CStr(FindActiveCell.Address())

Set appWd = CreateObject("Word.Application")
appWd.Visible = False
Set docWd = appWd.Documents.Add
Set objRange = docWd.Application.Selection.Range
objRange.Text = MyText
docWd.Application.Selection.OMaths.Add objRange
docWd.Application.Selection.OMaths.BuildUp
docWd.Application.Selection.WholeStory
docWd.Application.Selection.Copy

Range(NextActiveCell).Select
ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)",Link:=False,DisplayAsIcon:=False

appWd.Quit (False)
Set docWd = Nothing
Set appWd = Nothing

End Sub

Unfortunately, the pasted equation is the width of the Word document with lots of empty space e.g.

enter image description here

Is there a way to paste in just the equation without the space? It works fine if the image is pasted as a bitmap, but I need it to be an enhanced metafile.

Many thanks and best wishes.

Upvotes: 1

Views: 977

Answers (2)

Karlomanio
Karlomanio

Reputation: 371

Okay, after my discussion with you I came to a better understanding of what you want. I believe this should resolve the issue. Thanks for your patience.

Sub ExpandEqn(MyText As String)
    Dim appWd As Word.Application
    Dim docWd As Word.Document
    Dim objRange As Word.Range
    Dim objEq As OMath
    Dim FindActiveCell As Range
    Dim intColumnWidth As Integer
    Dim intRowHeight As Integer

    Set FindActiveCell = Application.ActiveCell
    GetRange = CStr(FindActiveCell.Address())
    ActiveCell.Offset(1, 0).Activate
    NextActiveCell = CStr(FindActiveCell.Address())

    Set appWd = CreateObject("Word.Application")
    appWd.Visible = False
    Set docWd = appWd.Documents.Add
    Set objRange = docWd.Application.Selection.Range
    objRange.Text = MyText
    docWd.Application.Selection.OMaths.Add objRange
    docWd.Application.Selection.OMaths.BuildUp
    docWd.Application.Selection.WholeStory
    docWd.Application.Selection.Copy

    ActiveCell.Offset(1, 0).Activate
    NextActiveCell = CStr(FindActiveCell.Address())
    Range(NextActiveCell).Select
    intColumnWidth = Range(NextActiveCell).ColumnWidth
    intRowHeight = Range(NextActiveCell).RowHeight
    docWd.Application.Selection.Columns.Width = intColumnWidth
    docWd.Application.Selection.Rows.Height = intRowHeight

    ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False

End Sub

Essentially what I did here was to the current width and height of the cell before pasting the item and then executing the paste. The object will then be pasted at the same size as the cell you are pasting into it.

Upvotes: 2

Geddes
Geddes

Reputation: 123

I have a solution - but it is pretty horrible:

  • Create the equation in word and copy it to the clipboard.
  • Paste it into Excel as a bitmap, which works fine - no extra space.
  • Get the width of the bitmap, then delete it.
  • Back into Word, resize the borders to that width and re-copy the equation.
  • Back into Excel, paste as enhanced metafile

This can all be done programmatically, but there must be a better way!

Upvotes: 0

Related Questions